{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Turtle.Prelude (
echo
, err
, readline
, Internal.readTextFile
, Internal.writeTextFile
, arguments
#if __GLASGOW_HASKELL__ >= 710
, export
, unset
#endif
, need
, env
, cd
, pwd
, home
, readlink
, realpath
, mv
, mkdir
, mktree
, cp
, cptree
, cptreeL
#if !defined(mingw32_HOST_OS)
, symlink
#endif
, isNotSymbolicLink
, rm
, rmdir
, rmtree
, testfile
, testdir
, testpath
, date
, datefile
, touch
, time
, hostname
, which
, whichAll
, sleep
, exit
, die
, (.&&.)
, (.||.)
, readonly
, writeonly
, appendonly
, mktemp
, mktempfile
, mktempdir
, fork
, wait
, pushd
, stdin
, input
, inhandle
, stdout
, output
, outhandle
, append
, stderr
, strict
, ls
, lsif
, lstree
, lsdepth
, cat
, grep
, grepText
, sed
, sedPrefix
, sedSuffix
, sedEntire
, onFiles
, inplace
, inplacePrefix
, inplaceSuffix
, inplaceEntire
, update
, find
, findtree
, yes
, nl
, paste
, endless
, limit
, limitWhile
, cache
, parallel
, single
, uniq
, uniqOn
, uniqBy
, nub
, nubOn
, sort
, sortOn
, sortBy
, toLines
, countChars
, countWords
, countLines
, cut
, proc
, shell
, procs
, shells
, inproc
, inshell
, inprocWithErr
, inshellWithErr
, procStrict
, shellStrict
, procStrictWithErr
, shellStrictWithErr
, system
, stream
, streamWithErr
, systemStrict
, systemStrictWithErr
, Permissions(..)
, chmod
, getmod
, setmod
, copymod
, readable, nonreadable
, writable, nonwritable
, executable, nonexecutable
, ooo,roo,owo,oox,rwo,rox,owx,rwx
, du
, Size(B, KB, MB, GB, TB, KiB, MiB, GiB, TiB)
, sz
, bytes
, kilobytes
, megabytes
, gigabytes
, terabytes
, kibibytes
, mebibytes
, gibibytes
, tebibytes
, PosixCompat.FileStatus
, stat
, lstat
, fileSize
, accessTime
, modificationTime
, statusChangeTime
, PosixCompat.isBlockDevice
, PosixCompat.isCharacterDevice
, PosixCompat.isNamedPipe
, PosixCompat.isRegularFile
, PosixCompat.isDirectory
, PosixCompat.isSymbolicLink
, PosixCompat.isSocket
, cmin
, cmax
, WithHeader(..)
, header
, ProcFailed(..)
, ShellFailed(..)
) where
import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
(Async, withAsync, waitSTM, concurrently,
Concurrently(..))
import qualified Control.Concurrent.Async
import Control.Concurrent.MVar (newMVar, modifyMVar_)
import qualified Control.Concurrent.STM as STM
import qualified Control.Concurrent.STM.TQueue as TQueue
import Control.Exception (Exception, bracket, bracket_, finally, mask, throwIO)
import Control.Foldl (Fold(..), genericLength, handles, list, premap)
import qualified Control.Foldl
import qualified Control.Foldl.Text
import Control.Monad (foldM, guard, liftM, msum, when, unless, (>=>), mfilter)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Managed (MonadManaged(..), managed, managed_, runManaged)
#ifdef mingw32_HOST_OS
import Data.Bits ((.&.))
#endif
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Monoid ((<>))
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text, pack, unpack)
import Data.Time (NominalDiffTime, UTCTime, getCurrentTime)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)
import Data.Traversable
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Data.Typeable (Typeable)
import GHC.IO.Exception (IOErrorType(UnsupportedOperation))
import Network.HostName (getHostName)
import System.Clock (Clock(..), TimeSpec(..), getTime)
import System.Environment (
getArgs,
#if __GLASGOW_HASKELL__ >= 710
setEnv,
unsetEnv,
#endif
#if __GLASGOW_HASKELL__ >= 708
lookupEnv,
#endif
getEnvironment )
import qualified System.Directory as Directory
import System.FilePath ((</>))
import qualified System.FilePath as FilePath
import System.Exit (ExitCode(..), exitWith)
import System.IO (Handle, hClose)
import qualified System.IO as IO
import System.IO.Temp (withTempDirectory, withTempFile)
import System.IO.Error
(catchIOError, ioeGetErrorType, isPermissionError, isDoesNotExistError)
import qualified System.PosixCompat as PosixCompat
import qualified System.Process as Process
#ifdef mingw32_HOST_OS
import qualified System.Win32 as Win32
#else
import System.Posix (
openDirStream,
readDirStream,
closeDirStream,
touchFile )
import System.Posix.Files (createSymbolicLink)
#endif
import Prelude hiding (lines)
import Turtle.Pattern (Pattern, anyChar, chars, match, selfless, sepBy)
import Turtle.Shell
import Turtle.Format (Format, format, makeFormat, d, w, (%), fp)
import qualified Turtle.Internal as Internal
import Turtle.Line
proc
:: MonadIO io
=> Text
-> [Text]
-> Shell Line
-> io ExitCode
proc :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ExitCode
proc Text
cmd [Text]
args =
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io ExitCode
system
( (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
unpack Text
cmd) (forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.Inherit
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
} )
shell
:: MonadIO io
=> Text
-> Shell Line
-> io ExitCode
shell :: forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io ExitCode
shell Text
cmdLine =
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io ExitCode
system
( (FilePath -> CreateProcess
Process.shell (Text -> FilePath
unpack Text
cmdLine))
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.Inherit
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
} )
data ProcFailed = ProcFailed
{ ProcFailed -> Text
procCommand :: Text
, ProcFailed -> [Text]
procArguments :: [Text]
, ProcFailed -> ExitCode
procExitCode :: ExitCode
} deriving (Int -> ProcFailed -> ShowS
[ProcFailed] -> ShowS
ProcFailed -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProcFailed] -> ShowS
$cshowList :: [ProcFailed] -> ShowS
show :: ProcFailed -> FilePath
$cshow :: ProcFailed -> FilePath
showsPrec :: Int -> ProcFailed -> ShowS
$cshowsPrec :: Int -> ProcFailed -> ShowS
Show, Typeable)
instance Exception ProcFailed
procs
:: MonadIO io
=> Text
-> [Text]
-> Shell Line
-> io ()
procs :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ()
procs Text
cmd [Text]
args Shell Line
s = do
ExitCode
exitCode <- forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ExitCode
proc Text
cmd [Text]
args Shell Line
s
case ExitCode
exitCode of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitCode
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO (Text -> [Text] -> ExitCode -> ProcFailed
ProcFailed Text
cmd [Text]
args ExitCode
exitCode))
data ShellFailed = ShellFailed
{ ShellFailed -> Text
shellCommandLine :: Text
, ShellFailed -> ExitCode
shellExitCode :: ExitCode
} deriving (Int -> ShellFailed -> ShowS
[ShellFailed] -> ShowS
ShellFailed -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ShellFailed] -> ShowS
$cshowList :: [ShellFailed] -> ShowS
show :: ShellFailed -> FilePath
$cshow :: ShellFailed -> FilePath
showsPrec :: Int -> ShellFailed -> ShowS
$cshowsPrec :: Int -> ShellFailed -> ShowS
Show, Typeable)
instance Exception ShellFailed
shells
:: MonadIO io
=> Text
-> Shell Line
-> io ()
shells :: forall (io :: * -> *). MonadIO io => Text -> Shell Line -> io ()
shells Text
cmdline Shell Line
s = do
ExitCode
exitCode <- forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io ExitCode
shell Text
cmdline Shell Line
s
case ExitCode
exitCode of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitCode
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO (Text -> ExitCode -> ShellFailed
ShellFailed Text
cmdline ExitCode
exitCode))
procStrict
:: MonadIO io
=> Text
-> [Text]
-> Shell Line
-> io (ExitCode, Text)
procStrict :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io (ExitCode, Text)
procStrict Text
cmd [Text]
args =
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Text.unpack Text
cmd) (forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack [Text]
args))
shellStrict
:: MonadIO io
=> Text
-> Shell Line
-> io (ExitCode, Text)
shellStrict :: forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io (ExitCode, Text)
shellStrict Text
cmdLine = forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Text.unpack Text
cmdLine))
procStrictWithErr
:: MonadIO io
=> Text
-> [Text]
-> Shell Line
-> io (ExitCode, Text, Text)
procStrictWithErr :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io (ExitCode, Text, Text)
procStrictWithErr Text
cmd [Text]
args =
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Text.unpack Text
cmd) (forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack [Text]
args))
shellStrictWithErr
:: MonadIO io
=> Text
-> Shell Line
-> io (ExitCode, Text, Text)
shellStrictWithErr :: forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io (ExitCode, Text, Text)
shellStrictWithErr Text
cmdLine =
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Text.unpack Text
cmdLine))
halt :: Async a -> IO ()
halt :: forall a. Async a -> IO ()
halt Async a
a = do
Maybe (Either SomeException a)
m <- forall a. Async a -> IO (Maybe (Either SomeException a))
Control.Concurrent.Async.poll Async a
a
case Maybe (Either SomeException a)
m of
Maybe (Either SomeException a)
Nothing -> forall a. Async a -> IO ()
Control.Concurrent.Async.cancel Async a
a
Just (Left SomeException
e) -> forall e a. Exception e => e -> IO a
throwIO SomeException
e
Just (Right a
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
system
:: MonadIO io
=> Process.CreateProcess
-> Shell Line
-> io ExitCode
system :: forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io ExitCode
system CreateProcess
p Shell Line
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let open :: IO (Maybe Handle, ProcessHandle)
open = do
(Maybe Handle
m, Maybe Handle
Nothing, Maybe Handle
Nothing, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p
case Maybe Handle
m of
Just Handle
hIn -> Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
Maybe Handle
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
m, ProcessHandle
ph)
MVar Bool
mvar <- forall a. a -> IO (MVar a)
newMVar Bool
False
let close :: Handle -> IO ()
close Handle
handle = do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
let close' :: (Maybe Handle, ProcessHandle) -> IO ()
close' (Just Handle
hIn, ProcessHandle
ph) = do
Handle -> IO ()
close Handle
hIn
ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph
close' (Maybe Handle
Nothing , ProcessHandle
ph) = do
ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph
let handle :: (Maybe Handle, ProcessHandle) -> IO ExitCode
handle (Just Handle
hIn, ProcessHandle
ph) = do
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\Async ()
a ->
forall a. IO a -> IO a
restore (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph) forall a b. IO a -> IO b -> IO a
`finally` forall a. Async a -> IO ()
halt Async ()
a) )
handle (Maybe Handle
Nothing , ProcessHandle
ph) = do
ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Maybe Handle, ProcessHandle)
open (Maybe Handle, ProcessHandle) -> IO ()
close' (Maybe Handle, ProcessHandle) -> IO ExitCode
handle )
systemStrict
:: MonadIO io
=> Process.CreateProcess
-> Shell Line
-> io (ExitCode, Text)
systemStrict :: forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict CreateProcess
p Shell Line
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
}
let open :: IO (Handle, Handle, ProcessHandle)
open = do
(Just Handle
hIn, Just Handle
hOut, Maybe Handle
Nothing, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, ProcessHandle
ph)
MVar Bool
mvar <- forall a. a -> IO (MVar a)
newMVar Bool
False
let close :: Handle -> IO ()
close Handle
handle = do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph) (\(Handle
hIn, Handle
hOut, ProcessHandle
ph) -> do
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
forall a b. IO a -> IO b -> IO (a, b)
concurrently
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\Async ()
a ->
forall a. IO a -> IO a
restore (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph)) forall a b. IO a -> IO b -> IO a
`finally` forall a. Async a -> IO ()
halt Async ()
a ) ))
(Handle -> IO Text
Text.hGetContents Handle
hOut) ) )
systemStrictWithErr
:: MonadIO io
=> Process.CreateProcess
-> Shell Line
-> io (ExitCode, Text, Text)
systemStrictWithErr :: forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr CreateProcess
p Shell Line
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.CreatePipe
}
let open :: IO (Handle, Handle, Handle, ProcessHandle)
open = do
(Just Handle
hIn, Just Handle
hOut, Just Handle
hErr, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph)
MVar Bool
mvar <- forall a. a -> IO (MVar a)
newMVar Bool
False
let close :: Handle -> IO ()
close Handle
handle = do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph) (\(Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph) -> do
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
forall a. Concurrently a -> IO a
runConcurrently forall a b. (a -> b) -> a -> b
$ (,,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Concurrently a
Concurrently (forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\Async ()
a ->
forall a. IO a -> IO a
restore (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph)) forall a b. IO a -> IO b -> IO a
`finally` forall a. Async a -> IO ()
halt Async ()
a ) ))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IO a -> Concurrently a
Concurrently (Handle -> IO Text
Text.hGetContents Handle
hOut)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IO a -> Concurrently a
Concurrently (Handle -> IO Text
Text.hGetContents Handle
hErr) ) )
inproc
:: Text
-> [Text]
-> Shell Line
-> Shell Line
inproc :: Text -> [Text] -> Shell Line -> Shell Line
inproc Text
cmd [Text]
args = CreateProcess -> Shell Line -> Shell Line
stream (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
unpack Text
cmd) (forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))
inshell
:: Text
-> Shell Line
-> Shell Line
inshell :: Text -> Shell Line -> Shell Line
inshell Text
cmd = CreateProcess -> Shell Line -> Shell Line
stream (FilePath -> CreateProcess
Process.shell (Text -> FilePath
unpack Text
cmd))
waitForProcessThrows :: Process.ProcessHandle -> IO ()
waitForProcessThrows :: ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph = do
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph
case ExitCode
exitCode of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure Int
_ -> forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExitCode
exitCode
stream
:: Process.CreateProcess
-> Shell Line
-> Shell Line
stream :: CreateProcess -> Shell Line -> Shell Line
stream CreateProcess
p Shell Line
s = do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
}
let open :: IO (Handle, Handle, ProcessHandle)
open = do
(Just Handle
hIn, Just Handle
hOut, Maybe Handle
Nothing, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, ProcessHandle
ph)
MVar Bool
mvar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO (MVar a)
newMVar Bool
False)
let close :: Handle -> IO ()
close Handle
handle = do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
(Handle
hIn, Handle
hOut, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore = forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
Async ()
a <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
(forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\Async () -> IO r
k ->
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (forall a. IO a -> IO a
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k))))
Handle -> Shell Line
inhandle Handle
hOut forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Async a -> IO ()
halt Async ()
a) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a
empty)
streamWithErr
:: Process.CreateProcess
-> Shell Line
-> Shell (Either Line Line)
streamWithErr :: CreateProcess -> Shell Line -> Shell (Either Line Line)
streamWithErr CreateProcess
p Shell Line
s = do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.CreatePipe
}
let open :: IO (Handle, Handle, Handle, ProcessHandle)
open = do
(Just Handle
hIn, Just Handle
hOut, Just Handle
hErr, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph)
MVar Bool
mvar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. a -> IO (MVar a)
newMVar Bool
False)
let close :: Handle -> IO ()
close Handle
handle = do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
(Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore = forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
TQueue (Maybe (Either Line Line))
queue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (TQueue a)
TQueue.newTQueueIO
let forwardOut :: (forall a. IO a -> IO a) -> IO ()
forwardOut :: (forall a. IO a -> IO a) -> IO ()
forwardOut forall a. IO a -> IO a
restore =
forall a. IO a -> IO a
restore (forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Line
line <- Handle -> Shell Line
inhandle Handle
hOut
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
STM.atomically (forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either Line Line))
queue (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right Line
line)))) ))
forall a b. IO a -> IO b -> IO a
`finally` forall a. STM a -> IO a
STM.atomically (forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either Line Line))
queue forall a. Maybe a
Nothing)
let forwardErr :: (forall a. IO a -> IO a) -> IO ()
forwardErr :: (forall a. IO a -> IO a) -> IO ()
forwardErr forall a. IO a -> IO a
restore =
forall a. IO a -> IO a
restore (forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Line
line <- Handle -> Shell Line
inhandle Handle
hErr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
STM.atomically (forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either Line Line))
queue (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left Line
line)))) ))
forall a b. IO a -> IO b -> IO a
`finally` forall a. STM a -> IO a
STM.atomically (forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either Line Line))
queue forall a. Maybe a
Nothing)
let drain :: Shell (Either Line Line)
drain = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> Either Line Line -> IO x
step x
begin x -> IO r
done) -> do
let loop :: x -> a -> IO x
loop x
x a
numNothing
| a
numNothing forall a. Ord a => a -> a -> Bool
< a
2 = do
Maybe (Either Line Line)
m <- forall a. STM a -> IO a
STM.atomically (forall a. TQueue a -> STM a
TQueue.readTQueue TQueue (Maybe (Either Line Line))
queue)
case Maybe (Either Line Line)
m of
Maybe (Either Line Line)
Nothing -> x -> a -> IO x
loop x
x forall a b. (a -> b) -> a -> b
$! a
numNothing forall a. Num a => a -> a -> a
+ a
1
Just Either Line Line
e -> do
x
x' <- x -> Either Line Line -> IO x
step x
x Either Line Line
e
x -> a -> IO x
loop x
x' a
numNothing
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return x
x
x
x1 <- forall {a}. (Ord a, Num a) => x -> a -> IO x
loop x
begin (Int
0 :: Int)
x -> IO r
done x
x1 )
Async ()
a <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
(forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\Async () -> IO r
k ->
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (forall a. IO a -> IO a
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k)) ))
Async ()
b <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
(forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\Async () -> IO r
k ->
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
forwardOut forall a. IO a -> IO a
restore) (forall a. IO a -> IO a
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k)) ))
Async ()
c <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
(forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\Async () -> IO r
k ->
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
forwardErr forall a. IO a -> IO a
restore) (forall a. IO a -> IO a
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k)) ))
let STM a
l also :: STM a -> STM a -> STM ()
`also` STM a
r = do
a
_ <- STM a
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (STM a
r forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. STM a
STM.retry)
a
_ <- STM a
r
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let waitAll :: IO ()
waitAll = forall a. STM a -> IO a
STM.atomically (forall a. Async a -> STM a
waitSTM Async ()
a forall {a} {a}. STM a -> STM a -> STM ()
`also` (forall a. Async a -> STM a
waitSTM Async ()
b forall {a} {a}. STM a -> STM a -> STM ()
`also` forall a. Async a -> STM a
waitSTM Async ()
c))
Shell (Either Line Line)
drain forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
waitAll) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a
empty)
inprocWithErr
:: Text
-> [Text]
-> Shell Line
-> Shell (Either Line Line)
inprocWithErr :: Text -> [Text] -> Shell Line -> Shell (Either Line Line)
inprocWithErr Text
cmd [Text]
args =
CreateProcess -> Shell Line -> Shell (Either Line Line)
streamWithErr (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
unpack Text
cmd) (forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))
inshellWithErr
:: Text
-> Shell Line
-> Shell (Either Line Line)
inshellWithErr :: Text -> Shell Line -> Shell (Either Line Line)
inshellWithErr Text
cmd = CreateProcess -> Shell Line -> Shell (Either Line Line)
streamWithErr (FilePath -> CreateProcess
Process.shell (Text -> FilePath
unpack Text
cmd))
echo :: MonadIO io => Line -> io ()
echo :: forall (io :: * -> *). MonadIO io => Line -> io ()
echo Line
line = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
Text.putStrLn (Line -> Text
lineToText Line
line))
err :: MonadIO io => Line -> io ()
err :: forall (io :: * -> *). MonadIO io => Line -> io ()
err Line
line = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
IO.stderr (Line -> Text
lineToText Line
line))
readline :: MonadIO io => io (Maybe Line)
readline :: forall (io :: * -> *). MonadIO io => io (Maybe Line)
readline = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
Bool
eof <- IO Bool
IO.isEOF
if Bool
eof
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Line
unsafeTextToLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) IO FilePath
getLine )
arguments :: MonadIO io => io [Text]
arguments :: forall (io :: * -> *). MonadIO io => io [Text]
arguments = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
pack) IO [FilePath]
getArgs)
#if __GLASGOW_HASKELL__ >= 710
export :: MonadIO io => Text -> Text -> io ()
export :: forall (io :: * -> *). MonadIO io => Text -> Text -> io ()
export Text
key Text
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO ()
setEnv (Text -> FilePath
unpack Text
key) (Text -> FilePath
unpack Text
val))
unset :: MonadIO io => Text -> io ()
unset :: forall (io :: * -> *). MonadIO io => Text -> io ()
unset Text
key = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
unsetEnv (Text -> FilePath
unpack Text
key))
#endif
need :: MonadIO io => Text -> io (Maybe Text)
#if __GLASGOW_HASKELL__ >= 708
need :: forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
need Text
key = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
pack) (FilePath -> IO (Maybe FilePath)
lookupEnv (Text -> FilePath
unpack Text
key)))
#else
need key = liftM (lookup key) env
#endif
env :: MonadIO io => io [(Text, Text)]
env :: forall (io :: * -> *). MonadIO io => io [(Text, Text)]
env = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, FilePath) -> (Text, Text)
toTexts) IO [(FilePath, FilePath)]
getEnvironment)
where
toTexts :: (FilePath, FilePath) -> (Text, Text)
toTexts (FilePath
key, FilePath
val) = (FilePath -> Text
pack FilePath
key, FilePath -> Text
pack FilePath
val)
cd :: MonadIO io => FilePath -> io ()
cd :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
cd FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.setCurrentDirectory FilePath
path)
pushd :: MonadManaged managed => FilePath -> managed ()
pushd :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed ()
pushd FilePath
path = do
FilePath
cwd <- forall (io :: * -> *). MonadIO io => io FilePath
pwd
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *).
MonadManaged m =>
(forall a. IO a -> IO a) -> m ()
managed_ (forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (forall (io :: * -> *). MonadIO io => FilePath -> io ()
cd FilePath
path) (forall (io :: * -> *). MonadIO io => FilePath -> io ()
cd FilePath
cwd)))
pwd :: MonadIO io => io FilePath
pwd :: forall (io :: * -> *). MonadIO io => io FilePath
pwd = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
Directory.getCurrentDirectory
home :: MonadIO io => io FilePath
home :: forall (io :: * -> *). MonadIO io => io FilePath
home = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
Directory.getHomeDirectory
readlink :: MonadIO io => FilePath -> io FilePath
readlink :: forall (io :: * -> *). MonadIO io => FilePath -> io FilePath
readlink FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
Directory.getSymbolicLinkTarget FilePath
path)
realpath :: MonadIO io => FilePath -> io FilePath
realpath :: forall (io :: * -> *). MonadIO io => FilePath -> io FilePath
realpath FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
Directory.canonicalizePath FilePath
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 :: FilePath -> Shell FilePath
ls FilePath
path = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> FilePath -> IO x
step x
begin x -> IO r
done) -> do
let path' :: FilePath
path' = FilePath
path
Bool
canRead <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
Permissions -> Bool
Directory.readable
(FilePath -> IO Permissions
Directory.getPermissions (ShowS
deslash FilePath
path'))
#ifdef mingw32_HOST_OS
reparse <- fmap reparsePoint (Win32.getFileAttributes path')
if (canRead && not reparse)
then bracket
(Win32.findFirstFile (path </> "*"))
(\(h, _) -> Win32.findClose h)
(\(h, fdat) -> do
let loop x = do
file <- Win32.getFindDataFileName fdat
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 $! begin )
else done begin )
#else
if Bool
canRead
then forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO DirStream
openDirStream FilePath
path') DirStream -> IO ()
closeDirStream (\DirStream
dirp -> do
let loop :: x -> IO r
loop x
x = do
FilePath
file <- DirStream -> IO FilePath
readDirStream DirStream
dirp
case FilePath
file of
FilePath
"" -> x -> IO r
done x
x
FilePath
_ -> do
x
x' <- if (FilePath
file forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
file forall a. Eq a => a -> a -> Bool
/= FilePath
"..")
then x -> FilePath -> IO x
step x
x (FilePath
path FilePath -> ShowS
</> FilePath
file)
else forall (m :: * -> *) a. Monad m => a -> m a
return x
x
x -> IO r
loop forall a b. (a -> b) -> a -> b
$! x
x'
x -> IO r
loop forall a b. (a -> b) -> a -> b
$! x
begin )
else x -> IO r
done x
begin )
#endif
deslash :: String -> String
deslash :: ShowS
deslash [] = []
deslash (Char
c0:FilePath
cs0) = Char
c0forall a. a -> [a] -> [a]
:ShowS
go FilePath
cs0
where
go :: ShowS
go [] = []
go [Char
'\\'] = []
go (Char
c:FilePath
cs) = Char
cforall a. a -> [a] -> [a]
:ShowS
go FilePath
cs
lstree :: FilePath -> Shell FilePath
lstree :: FilePath -> Shell FilePath
lstree FilePath
path = do
FilePath
child <- FilePath -> Shell FilePath
ls FilePath
path
Bool
isDir <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
if Bool
isDir
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Shell FilePath
lstree FilePath
child
else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
lsdepth :: Int -> Int -> FilePath -> Shell FilePath
lsdepth :: Int -> Int -> FilePath -> Shell FilePath
lsdepth Int
mn Int
mx FilePath
path =
Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper Int
1 Int
mn Int
mx FilePath
path
where
lsdepthHelper :: Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper :: Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper Int
depth Int
l Int
u FilePath
p =
if Int
depth forall a. Ord a => a -> a -> Bool
> Int
u
then forall (f :: * -> *) a. Alternative f => f a
empty
else do
FilePath
child <- FilePath -> Shell FilePath
ls FilePath
p
Bool
isDir <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
if Bool
isDir
then if Int
depth forall a. Ord a => a -> a -> Bool
>= Int
l
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper (Int
depth forall a. Num a => a -> a -> a
+ Int
1) Int
l Int
u FilePath
child
else Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper (Int
depth forall a. Num a => a -> a -> a
+ Int
1) Int
l Int
u FilePath
child
else if Int
depth forall a. Ord a => a -> a -> Bool
>= Int
l
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
else forall (f :: * -> *) a. Alternative f => f a
empty
lsif :: (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif :: (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
predicate FilePath
path = do
FilePath
child <- FilePath -> Shell FilePath
ls FilePath
path
Bool
isDir <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
if Bool
isDir
then do
Bool
continue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
predicate FilePath
child)
if Bool
continue
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
predicate FilePath
child
else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
mv :: MonadIO io => FilePath -> FilePath -> io ()
mv :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
mv FilePath
oldPath FilePath
newPath = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (FilePath -> FilePath -> IO ()
Directory.renameFile FilePath
oldPath FilePath
newPath)
(\IOError
ioe -> if IOError -> IOErrorType
ioeGetErrorType IOError
ioe forall a. Eq a => a -> a -> Bool
== IOErrorType
UnsupportedOperation
then do
FilePath -> FilePath -> IO ()
Directory.copyFile FilePath
oldPath FilePath
newPath
FilePath -> IO ()
Directory.removeFile FilePath
oldPath
else forall a. IOError -> IO a
ioError IOError
ioe)
mkdir :: MonadIO io => FilePath -> io ()
mkdir :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
mkdir FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.createDirectory FilePath
path)
mktree :: MonadIO io => FilePath -> io ()
mktree :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True FilePath
path)
cp :: MonadIO io => FilePath -> FilePath -> io ()
cp :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cp FilePath
oldPath FilePath
newPath = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO ()
Directory.copyFile FilePath
oldPath FilePath
newPath)
#if !defined(mingw32_HOST_OS)
symlink :: MonadIO io => FilePath -> FilePath -> io ()
symlink :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
symlink FilePath
a FilePath
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createSymbolicLink (ShowS
fp2fp FilePath
a) (ShowS
fp2fp FilePath
b)
where
fp2fp :: ShowS
fp2fp = Text -> FilePath
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Format Text r -> r
format forall r. Format r (FilePath -> r)
fp
#endif
isNotSymbolicLink :: MonadIO io => FilePath -> io Bool
isNotSymbolicLink :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
isNotSymbolicLink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
PosixCompat.isSymbolicLink) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat
cptree :: MonadIO io => FilePath -> FilePath -> io ()
cptree :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cptree FilePath
oldTree FilePath
newTree = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
FilePath
oldPath <- (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif forall (io :: * -> *). MonadIO io => FilePath -> io Bool
isNotSymbolicLink FilePath
oldTree
Just FilePath
suffix <- forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> Maybe FilePath
Internal.stripPrefix (FilePath
oldTree forall a. Semigroup a => a -> a -> a
<> [ Char
FilePath.pathSeparator ]) FilePath
oldPath)
let newPath :: FilePath
newPath = FilePath
newTree FilePath -> ShowS
</> FilePath
suffix
Bool
isFile <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
oldPath
FileStatus
fileStatus <- forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
oldPath
if FileStatus -> Bool
PosixCompat.isSymbolicLink FileStatus
fileStatus
then do
FilePath
oldTarget <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
PosixCompat.readSymbolicLink FilePath
oldPath)
forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree (ShowS
FilePath.takeDirectory FilePath
newPath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO ()
PosixCompat.createSymbolicLink FilePath
oldTarget FilePath
newPath)
else if Bool
isFile
then do
forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree (ShowS
FilePath.takeDirectory FilePath
newPath)
forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cp FilePath
oldPath FilePath
newPath
else do
forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree FilePath
newPath )
cptreeL :: MonadIO io => FilePath -> FilePath -> io ()
cptreeL :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cptreeL FilePath
oldTree FilePath
newTree = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
FilePath
oldPath <- FilePath -> Shell FilePath
lstree FilePath
oldTree
Just FilePath
suffix <- forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> Maybe FilePath
Internal.stripPrefix (FilePath
oldTree forall a. [a] -> [a] -> [a]
++ FilePath
"/") FilePath
oldPath)
let newPath :: FilePath
newPath = FilePath
newTree FilePath -> ShowS
</> FilePath
suffix
Bool
isFile <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
oldPath
if Bool
isFile
then forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree (ShowS
FilePath.takeDirectory FilePath
newPath) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cp FilePath
oldPath FilePath
newPath
else forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree FilePath
newPath )
rm :: MonadIO io => FilePath -> io ()
rm :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
rm FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.removeFile FilePath
path)
rmdir :: MonadIO io => FilePath -> io ()
rmdir :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
rmdir FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.removeDirectory FilePath
path)
rmtree :: MonadIO io => FilePath -> io ()
rmtree :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
rmtree FilePath
path0 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (FilePath -> Shell ()
loop FilePath
path0))
where
loop :: FilePath -> Shell ()
loop FilePath
path = do
FileStatus
linkstat <- forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
path
let isLink :: Bool
isLink = FileStatus -> Bool
PosixCompat.isSymbolicLink FileStatus
linkstat
isDir :: Bool
isDir = FileStatus -> Bool
PosixCompat.isDirectory FileStatus
linkstat
if Bool
isLink
then forall (io :: * -> *). MonadIO io => FilePath -> io ()
rm FilePath
path
else do
if Bool
isDir
then (do
FilePath
child <- FilePath -> Shell FilePath
ls FilePath
path
FilePath -> Shell ()
loop FilePath
child ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (io :: * -> *). MonadIO io => FilePath -> io ()
rmdir FilePath
path
else forall (io :: * -> *). MonadIO io => FilePath -> io ()
rm FilePath
path
testfile :: MonadIO io => FilePath -> io Bool
testfile :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
Directory.doesFileExist FilePath
path)
testdir :: MonadIO io => FilePath -> io Bool
testdir :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
path)
testpath :: MonadIO io => FilePath -> io Bool
testpath :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testpath FilePath
path = do
Bool
exists <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
else forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
path
touch :: MonadIO io => FilePath -> io ()
touch :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
touch FilePath
file = do
Bool
exists <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (if Bool
exists
#ifdef mingw32_HOST_OS
then do
handle <- Win32.createFile
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 (Just creationTime) (Just systemTime) (Just systemTime)
#else
then FilePath -> IO ()
touchFile FilePath
file
#endif
else forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
output FilePath
file forall (f :: * -> *) a. Alternative f => f a
empty )
data Permissions = Permissions
{ Permissions -> Bool
_readable :: Bool
, Permissions -> Bool
_writable :: Bool
, Permissions -> Bool
_executable :: Bool
} deriving (Permissions -> Permissions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c== :: Permissions -> Permissions -> Bool
Eq, ReadPrec [Permissions]
ReadPrec Permissions
Int -> ReadS Permissions
ReadS [Permissions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Permissions]
$creadListPrec :: ReadPrec [Permissions]
readPrec :: ReadPrec Permissions
$creadPrec :: ReadPrec Permissions
readList :: ReadS [Permissions]
$creadList :: ReadS [Permissions]
readsPrec :: Int -> ReadS Permissions
$creadsPrec :: Int -> ReadS Permissions
Read, Eq Permissions
Permissions -> Permissions -> Bool
Permissions -> Permissions -> Ordering
Permissions -> Permissions -> Permissions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmax :: Permissions -> Permissions -> Permissions
>= :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c< :: Permissions -> Permissions -> Bool
compare :: Permissions -> Permissions -> Ordering
$ccompare :: Permissions -> Permissions -> Ordering
Ord, Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Permissions] -> ShowS
$cshowList :: [Permissions] -> ShowS
show :: Permissions -> FilePath
$cshow :: Permissions -> FilePath
showsPrec :: Int -> Permissions -> ShowS
$cshowsPrec :: Int -> Permissions -> ShowS
Show)
toSystemDirectoryPermissions :: Permissions -> Directory.Permissions
toSystemDirectoryPermissions :: Permissions -> Permissions
toSystemDirectoryPermissions Permissions
p =
( Bool -> Permissions -> Permissions
Directory.setOwnerReadable (Permissions -> Bool
_readable Permissions
p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Permissions -> Permissions
Directory.setOwnerWritable (Permissions -> Bool
_writable Permissions
p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Permissions -> Permissions
Directory.setOwnerExecutable (Permissions -> Bool
_executable Permissions
p)
) Permissions
Directory.emptyPermissions
fromSystemDirectoryPermissions :: Directory.Permissions -> Permissions
fromSystemDirectoryPermissions :: Permissions -> Permissions
fromSystemDirectoryPermissions Permissions
p = Permissions
{ _readable :: Bool
_readable = Permissions -> Bool
Directory.readable Permissions
p
, _writable :: Bool
_writable = Permissions -> Bool
Directory.writable Permissions
p
, _executable :: Bool
_executable =
Permissions -> Bool
Directory.executable Permissions
p Bool -> Bool -> Bool
|| Permissions -> Bool
Directory.searchable Permissions
p
}
chmod
:: MonadIO io
=> (Permissions -> Permissions)
-> FilePath
-> io Permissions
chmod :: forall (io :: * -> *).
MonadIO io =>
(Permissions -> Permissions) -> FilePath -> io Permissions
chmod Permissions -> Permissions
modifyPermissions FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let path' :: FilePath
path' = ShowS
deslash FilePath
path
Permissions
permissions <- FilePath -> IO Permissions
Directory.getPermissions FilePath
path'
let permissions' :: Permissions
permissions' = Permissions -> Permissions
fromSystemDirectoryPermissions Permissions
permissions
let permissions'' :: Permissions
permissions'' = Permissions -> Permissions
modifyPermissions Permissions
permissions'
changed :: Bool
changed = Permissions
permissions' forall a. Eq a => a -> a -> Bool
/= Permissions
permissions''
let permissions''' :: Permissions
permissions''' = Permissions -> Permissions
toSystemDirectoryPermissions Permissions
permissions''
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
path' Permissions
permissions''')
forall (m :: * -> *) a. Monad m => a -> m a
return Permissions
permissions'' )
getmod :: MonadIO io => FilePath -> io Permissions
getmod :: forall (io :: * -> *). MonadIO io => FilePath -> io Permissions
getmod FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let path' :: FilePath
path' = ShowS
deslash FilePath
path
Permissions
permissions <- FilePath -> IO Permissions
Directory.getPermissions FilePath
path'
forall (m :: * -> *) a. Monad m => a -> m a
return (Permissions -> Permissions
fromSystemDirectoryPermissions Permissions
permissions))
setmod :: MonadIO io => Permissions -> FilePath -> io ()
setmod :: forall (io :: * -> *).
MonadIO io =>
Permissions -> FilePath -> io ()
setmod Permissions
permissions FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let path' :: FilePath
path' = ShowS
deslash FilePath
path
FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
path' (Permissions -> Permissions
toSystemDirectoryPermissions Permissions
permissions) )
copymod :: MonadIO io => FilePath -> FilePath -> io ()
copymod :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
copymod FilePath
sourcePath FilePath
targetPath = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let sourcePath' :: FilePath
sourcePath' = ShowS
deslash FilePath
sourcePath
targetPath' :: FilePath
targetPath' = ShowS
deslash FilePath
targetPath
FilePath -> FilePath -> IO ()
Directory.copyPermissions FilePath
sourcePath' FilePath
targetPath' )
readable :: Permissions -> Permissions
readable :: Permissions -> Permissions
readable Permissions
p = Permissions
p { _readable :: Bool
_readable = Bool
True }
nonreadable :: Permissions -> Permissions
nonreadable :: Permissions -> Permissions
nonreadable Permissions
p = Permissions
p { _readable :: Bool
_readable = Bool
False }
writable :: Permissions -> Permissions
writable :: Permissions -> Permissions
writable Permissions
p = Permissions
p { _writable :: Bool
_writable = Bool
True }
nonwritable :: Permissions -> Permissions
nonwritable :: Permissions -> Permissions
nonwritable Permissions
p = Permissions
p { _writable :: Bool
_writable = Bool
False }
executable :: Permissions -> Permissions
executable :: Permissions -> Permissions
executable Permissions
p = Permissions
p { _executable :: Bool
_executable = Bool
True }
nonexecutable :: Permissions -> Permissions
nonexecutable :: Permissions -> Permissions
nonexecutable Permissions
p = Permissions
p { _executable :: Bool
_executable = Bool
False }
ooo :: Permissions -> Permissions
ooo :: Permissions -> Permissions
ooo Permissions
_ = Permissions
{ _readable :: Bool
_readable = Bool
False
, _writable :: Bool
_writable = Bool
False
, _executable :: Bool
_executable = Bool
False
}
roo :: Permissions -> Permissions
roo :: Permissions -> Permissions
roo = Permissions -> Permissions
readable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
owo :: Permissions -> Permissions
owo :: Permissions -> Permissions
owo = Permissions -> Permissions
writable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
oox :: Permissions -> Permissions
oox :: Permissions -> Permissions
oox = Permissions -> Permissions
executable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
rwo :: Permissions -> Permissions
rwo :: Permissions -> Permissions
rwo = Permissions -> Permissions
readable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
writable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
rox :: Permissions -> Permissions
rox :: Permissions -> Permissions
rox = Permissions -> Permissions
readable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
executable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
owx :: Permissions -> Permissions
owx :: Permissions -> Permissions
owx = Permissions -> Permissions
writable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
executable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
rwx :: Permissions -> Permissions
rwx :: Permissions -> Permissions
rwx = Permissions -> Permissions
readable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
writable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
executable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo
time :: MonadIO io => io a -> io (a, NominalDiffTime)
time :: forall (io :: * -> *) a. MonadIO io => io a -> io (a, POSIXTime)
time io a
io = do
TimeSpec Int64
seconds1 Int64
nanoseconds1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
a
a <- io a
io
TimeSpec Int64
seconds2 Int64
nanoseconds2 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
let t :: Rational
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral ( Int64
seconds2 forall a. Num a => a -> a -> a
- Int64
seconds1)
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
nanoseconds2 forall a. Num a => a -> a -> a
- Int64
nanoseconds1) forall a. Fractional a => a -> a -> a
/ Rational
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9::Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall a. Fractional a => Rational -> a
fromRational Rational
t)
hostname :: MonadIO io => io Text
hostname :: forall (io :: * -> *). MonadIO io => io Text
hostname = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack IO FilePath
getHostName)
which :: MonadIO io => FilePath -> io (Maybe FilePath)
which :: forall (io :: * -> *).
MonadIO io =>
FilePath -> io (Maybe FilePath)
which FilePath
cmd = forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold (FilePath -> Shell FilePath
whichAll FilePath
cmd) forall a. Fold a (Maybe a)
Control.Foldl.head
whichAll :: FilePath -> Shell FilePath
whichAll :: FilePath -> Shell FilePath
whichAll FilePath
cmd = do
Just Text
paths <- forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
need Text
"PATH"
FilePath
path <- forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack (Text -> Text -> [Text]
Text.splitOn Text
":" Text
paths))
let path' :: FilePath
path' = FilePath
path FilePath -> ShowS
</> FilePath
cmd
Bool
True <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path'
let handler :: IOError -> IO Bool
handler :: IOError -> IO Bool
handler IOError
e =
if IOError -> Bool
isPermissionError IOError
e Bool -> Bool -> Bool
|| IOError -> Bool
isDoesNotExistError IOError
e
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else forall e a. Exception e => e -> IO a
throwIO IOError
e
let getIsExecutable :: IO Bool
getIsExecutable = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Permissions -> Bool
_executable (forall (io :: * -> *). MonadIO io => FilePath -> io Permissions
getmod FilePath
path')
Bool
isExecutable <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
getIsExecutable forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` IOError -> IO Bool
handler)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isExecutable
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path'
sleep :: MonadIO io => NominalDiffTime -> io ()
sleep :: forall (io :: * -> *). MonadIO io => POSIXTime -> io ()
sleep POSIXTime
n = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay (forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime
n forall a. Num a => a -> a -> a
* POSIXTime
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int))))
exit :: MonadIO io => ExitCode -> io a
exit :: forall (io :: * -> *) a. MonadIO io => ExitCode -> io a
exit ExitCode
code = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ExitCode -> IO a
exitWith ExitCode
code)
die :: MonadIO io => Text -> io a
die :: forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
txt = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO (FilePath -> IOError
userError (Text -> FilePath
unpack Text
txt)))
infixr 2 .||.
infixr 3 .&&.
(.&&.) :: Monad m => m ExitCode -> m ExitCode -> m ExitCode
m ExitCode
cmd1 .&&. :: forall (m :: * -> *).
Monad m =>
m ExitCode -> m ExitCode -> m ExitCode
.&&. m ExitCode
cmd2 = do
ExitCode
r <- m ExitCode
cmd1
case ExitCode
r of
ExitCode
ExitSuccess -> m ExitCode
cmd2
ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
r
(.||.) :: Monad m => m ExitCode -> m ExitCode -> m ExitCode
m ExitCode
cmd1 .||. :: forall (m :: * -> *).
Monad m =>
m ExitCode -> m ExitCode -> m ExitCode
.||. m ExitCode
cmd2 = do
ExitCode
r <- m ExitCode
cmd1
case ExitCode
r of
ExitFailure Int
_ -> m ExitCode
cmd2
ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
r
mktempdir
:: MonadManaged managed
=> FilePath
-> Text
-> managed FilePath
mktempdir :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed FilePath
mktempdir FilePath
parent Text
prefix = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTempDirectory FilePath
parent FilePath
prefix'))
mktemp
:: MonadManaged managed
=> FilePath
-> Text
-> managed (FilePath, Handle)
mktemp :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed (FilePath, Handle)
mktemp FilePath
parent Text
prefix = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
(FilePath
file', Handle
handle) <- forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\(FilePath, Handle) -> IO r
k ->
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile FilePath
parent FilePath
prefix' (\FilePath
file' Handle
handle -> (FilePath, Handle) -> IO r
k (FilePath
file', Handle
handle)) )
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file', Handle
handle) )
mktempfile
:: MonadManaged managed
=> FilePath
-> Text
-> managed FilePath
mktempfile :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed FilePath
mktempfile FilePath
parent Text
prefix = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
(FilePath
file', Handle
handle) <- forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\(FilePath, Handle) -> IO r
k ->
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile FilePath
parent FilePath
prefix' (\FilePath
file' Handle
handle -> (FilePath, Handle) -> IO r
k (FilePath
file', Handle
handle)) )
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle)
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file' )
fork :: MonadManaged managed => IO a -> managed (Async a)
fork :: forall (managed :: * -> *) a.
MonadManaged managed =>
IO a -> managed (Async a)
fork IO a
io = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO a
io))
wait :: MonadIO io => Async a -> io a
wait :: forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async a
a = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Async a -> IO a
Control.Concurrent.Async.wait Async a
a)
stdin :: Shell Line
stdin :: Shell Line
stdin = Handle -> Shell Line
inhandle Handle
IO.stdin
input :: FilePath -> Shell Line
input :: FilePath -> Shell Line
input FilePath
file = do
Handle
handle <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
readonly FilePath
file)
Handle -> Shell Line
inhandle Handle
handle
inhandle :: Handle -> Shell Line
inhandle :: Handle -> Shell Line
inhandle Handle
handle = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> Line -> IO x
step x
begin x -> IO r
done) -> do
let loop :: x -> IO r
loop x
x = do
Bool
eof <- Handle -> IO Bool
IO.hIsEOF Handle
handle
if Bool
eof
then x -> IO r
done x
x
else do
Text
txt <- Handle -> IO Text
Text.hGetLine Handle
handle
x
x' <- x -> Line -> IO x
step x
x (Text -> Line
unsafeTextToLine Text
txt)
x -> IO r
loop forall a b. (a -> b) -> a -> b
$! x
x'
x -> IO r
loop forall a b. (a -> b) -> a -> b
$! x
begin )
stdout :: MonadIO io => Shell Line -> io ()
stdout :: forall (io :: * -> *). MonadIO io => Shell Line -> io ()
stdout Shell Line
s = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Line
line <- Shell Line
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (io :: * -> *). MonadIO io => Line -> io ()
echo Line
line) )
output :: MonadIO io => FilePath -> Shell Line -> io ()
output :: forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
output FilePath
file Shell Line
s = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Handle
handle <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
writeonly FilePath
file)
Line
line <- Shell Line
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (Line -> Text
lineToText Line
line)) )
outhandle :: MonadIO io => Handle -> Shell Line -> io ()
outhandle :: forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
handle Shell Line
s = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Line
line <- Shell Line
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (Line -> Text
lineToText Line
line)) )
append :: MonadIO io => FilePath -> Shell Line -> io ()
append :: forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
append FilePath
file Shell Line
s = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Handle
handle <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
appendonly FilePath
file)
Line
line <- Shell Line
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (Line -> Text
lineToText Line
line)) )
stderr :: MonadIO io => Shell Line -> io ()
stderr :: forall (io :: * -> *). MonadIO io => Shell Line -> io ()
stderr Shell Line
s = forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Line
line <- Shell Line
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (io :: * -> *). MonadIO io => Line -> io ()
err Line
line) )
strict :: MonadIO io => Shell Line -> io Text
strict :: forall (io :: * -> *). MonadIO io => Shell Line -> io Text
strict Shell Line
s = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Line] -> Text
linesToText (forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell Line
s forall a. Fold a [a]
list)
readonly :: MonadManaged managed => FilePath -> managed Handle
readonly :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
readonly FilePath
file = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
file IOMode
IO.ReadMode))
writeonly :: MonadManaged managed => FilePath -> managed Handle
writeonly :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
writeonly FilePath
file = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
file IOMode
IO.WriteMode))
appendonly :: MonadManaged managed => FilePath -> managed Handle
appendonly :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
appendonly FilePath
file = forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
file IOMode
IO.AppendMode))
cat :: [Shell a] -> Shell a
cat :: forall a. [Shell a] -> Shell a
cat = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
grepWith :: (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith :: forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith b -> Text
f Pattern a
pattern' = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pattern a -> Text -> [a]
match Pattern a
pattern' forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Text
f)
grep :: Pattern a -> Shell Line -> Shell Line
grep :: forall a. Pattern a -> Shell Line -> Shell Line
grep = forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith Line -> Text
lineToText
grepText :: Pattern a -> Shell Text -> Shell Text
grepText :: forall a. Pattern a -> Shell Text -> Shell Text
grepText = forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith forall a. a -> a
id
sed :: Pattern Text -> Shell Line -> Shell Line
sed :: Pattern Text -> Shell Line -> Shell Line
sed Pattern Text
pattern' Shell Line
s = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {a}. Pattern a -> Bool
matchesEmpty Pattern Text
pattern') (forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
message)
let pattern'' :: Pattern Text
pattern'' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat
(forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Pattern Text
pattern' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton Pattern Char
anyChar))
Line
line <- Shell Line
s
Text
txt':[Text]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match Pattern Text
pattern'' (Line -> Text
lineToText Line
line))
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')
where
message :: Text
message = Text
"sed: the given pattern matches the empty string"
matchesEmpty :: Pattern a -> Bool
matchesEmpty = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Pattern a -> Text -> [a]
match Text
""
sedPrefix :: Pattern Text -> Shell Line -> Shell Line
sedPrefix :: Pattern Text -> Shell Line -> Shell Line
sedPrefix Pattern Text
pattern' Shell Line
s = do
Line
line <- Shell Line
s
Text
txt':[Text]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match ((Pattern Text
pattern' forall a. Semigroup a => a -> a -> a
<> Pattern Text
chars) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars) (Line -> Text
lineToText Line
line))
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')
sedSuffix :: Pattern Text -> Shell Line -> Shell Line
sedSuffix :: Pattern Text -> Shell Line -> Shell Line
sedSuffix Pattern Text
pattern' Shell Line
s = do
Line
line <- Shell Line
s
Text
txt':[Text]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match ((Pattern Text
chars forall a. Semigroup a => a -> a -> a
<> Pattern Text
pattern') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars) (Line -> Text
lineToText Line
line))
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')
sedEntire :: Pattern Text -> Shell Line -> Shell Line
sedEntire :: Pattern Text -> Shell Line -> Shell Line
sedEntire Pattern Text
pattern' Shell Line
s = do
Line
line <- Shell Line
s
Text
txt':[Text]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match (Pattern Text
pattern' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars)(Line -> Text
lineToText Line
line))
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')
onFiles :: (Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath
onFiles :: (Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath
onFiles Shell Text -> Shell Text
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shell Text -> Shell Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack
inplace :: MonadIO io => Pattern Text -> FilePath -> io ()
inplace :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplace = forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sed
inplacePrefix :: MonadIO io => Pattern Text -> FilePath -> io ()
inplacePrefix :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplacePrefix = forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sedPrefix
inplaceSuffix :: MonadIO io => Pattern Text -> FilePath -> io ()
inplaceSuffix :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplaceSuffix = forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sedSuffix
inplaceEntire :: MonadIO io => Pattern Text -> FilePath -> io ()
inplaceEntire :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplaceEntire = forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sedEntire
update :: MonadIO io => (Shell Line -> Shell Line) -> FilePath -> io ()
update :: forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update Shell Line -> Shell Line
f FilePath
file = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Managed () -> IO ()
runManaged (do
FilePath
here <- forall (io :: * -> *). MonadIO io => io FilePath
pwd
(FilePath
tmpfile, Handle
handle) <- forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed (FilePath, Handle)
mktemp FilePath
here Text
"turtle"
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
handle (Shell Line -> Shell Line
f (FilePath -> Shell Line
input FilePath
file))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle)
forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
copymod FilePath
file FilePath
tmpfile
forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
mv FilePath
tmpfile FilePath
file ))
find :: Pattern a -> FilePath -> Shell FilePath
find :: forall a. Pattern a -> FilePath -> Shell FilePath
find Pattern a
pattern' FilePath
dir = do
FilePath
path <- (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
isNotSymlink FilePath
dir
let txt :: Text
txt = FilePath -> Text
Text.pack FilePath
path
a
_:[a]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match Pattern a
pattern' Text
txt)
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
where
isNotSymlink :: FilePath -> IO Bool
isNotSymlink :: FilePath -> IO Bool
isNotSymlink FilePath
file = do
FileStatus
file_stat <- forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not (FileStatus -> Bool
PosixCompat.isSymbolicLink FileStatus
file_stat))
findtree :: Pattern a -> Shell FilePath -> Shell FilePath
findtree :: forall a. Pattern a -> Shell FilePath -> Shell FilePath
findtree Pattern a
pat Shell FilePath
files = do
FilePath
path <- Shell FilePath
files
let txt :: Text
txt = FilePath -> Text
Text.pack FilePath
path
a
_:[a]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match Pattern a
pat Text
txt)
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
cmin :: MonadIO io => UTCTime -> FilePath -> io Bool
cmin :: forall (io :: * -> *). MonadIO io => UTCTime -> FilePath -> io Bool
cmin UTCTime
t FilePath
file = do
FileStatus
status <- forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> Bool
adapt FileStatus
status)
where
adapt :: FileStatus -> Bool
adapt FileStatus
x = POSIXTime -> UTCTime
posixSecondsToUTCTime (FileStatus -> POSIXTime
modificationTime FileStatus
x) forall a. Ord a => a -> a -> Bool
> UTCTime
t
cmax :: MonadIO io => UTCTime -> FilePath -> io Bool
cmax :: forall (io :: * -> *). MonadIO io => UTCTime -> FilePath -> io Bool
cmax UTCTime
t FilePath
file = do
FileStatus
status <- forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> Bool
adapt FileStatus
status)
where
adapt :: FileStatus -> Bool
adapt FileStatus
x = POSIXTime -> UTCTime
posixSecondsToUTCTime (FileStatus -> POSIXTime
modificationTime FileStatus
x) forall a. Ord a => a -> a -> Bool
< UTCTime
t
yes :: Shell Line
yes :: Shell Line
yes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\()
_ -> Line
"y") Shell ()
endless
nl :: Num n => Shell a -> Shell (n, a)
nl :: forall n a. Num n => Shell a -> Shell (n, a)
nl Shell a
s = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b} {b}. Num b => FoldShell (b, a) b -> IO b
_foldShell'
where
_foldShell' :: FoldShell (b, a) b -> IO b
_foldShell' (FoldShell x -> (b, a) -> IO x
step x
begin x -> IO b
done) = forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell (x, b) -> a -> IO (x, b)
step' (x, b)
begin' forall {b}. (x, b) -> IO b
done')
where
step' :: (x, b) -> a -> IO (x, b)
step' (x
x, b
n) a
a = do
x
x' <- x -> (b, a) -> IO x
step x
x (b
n, a
a)
let n' :: b
n' = b
n forall a. Num a => a -> a -> a
+ b
1
b
n' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (x
x', b
n')
begin' :: (x, b)
begin' = (x
begin, b
0)
done' :: (x, b) -> IO b
done' (x
x, b
_) = x -> IO b
done x
x
data ZipState a b = Empty | HasA a | HasAB a b | Done
paste :: Shell a -> Shell b -> Shell (a, b)
paste :: forall a b. Shell a -> Shell b -> Shell (a, b)
paste Shell a
sA Shell b
sB = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b}. FoldShell (a, b) b -> IO b
_foldShellAB
where
_foldShellAB :: FoldShell (a, b) b -> IO b
_foldShellAB (FoldShell x -> (a, b) -> IO x
stepAB x
beginAB x -> IO b
doneAB) = do
TVar (ZipState a b)
tvar <- forall a. STM a -> IO a
STM.atomically (forall a. a -> STM (TVar a)
STM.newTVar forall a b. ZipState a b
Empty)
let begin :: ()
begin = ()
let stepA :: () -> a -> IO ()
stepA () a
a = forall a. STM a -> IO a
STM.atomically (do
ZipState a b
x <- forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
case ZipState a b
x of
ZipState a b
Empty -> forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar (forall a b. a -> ZipState a b
HasA a
a)
ZipState a b
Done -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ZipState a b
_ -> forall a. STM a
STM.retry )
let doneA :: () -> IO ()
doneA () = forall a. STM a -> IO a
STM.atomically (do
ZipState a b
x <- forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
case ZipState a b
x of
ZipState a b
Empty -> forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar forall a b. ZipState a b
Done
ZipState a b
Done -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ZipState a b
_ -> forall a. STM a
STM.retry )
let foldA :: FoldShell a ()
foldA = forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell () -> a -> IO ()
stepA ()
begin () -> IO ()
doneA
let stepB :: () -> b -> IO ()
stepB () b
b = forall a. STM a -> IO a
STM.atomically (do
ZipState a b
x <- forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
case ZipState a b
x of
HasA a
a -> forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar (forall a b. a -> b -> ZipState a b
HasAB a
a b
b)
ZipState a b
Done -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ZipState a b
_ -> forall a. STM a
STM.retry )
let doneB :: () -> IO ()
doneB () = forall a. STM a -> IO a
STM.atomically (do
ZipState a b
x <- forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
case ZipState a b
x of
HasA a
_ -> forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar forall a b. ZipState a b
Done
ZipState a b
Done -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
ZipState a b
_ -> forall a. STM a
STM.retry )
let foldB :: FoldShell b ()
foldB = forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell () -> b -> IO ()
stepB ()
begin () -> IO ()
doneB
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
sA FoldShell a ()
foldA) (\Async ()
asyncA -> do
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell b
sB FoldShell b ()
foldB) (\Async ()
asyncB -> do
let loop :: x -> IO x
loop x
x = do
Maybe (a, b)
y <- forall a. STM a -> IO a
STM.atomically (do
ZipState a b
z <- forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
case ZipState a b
z of
HasAB a
a b
b -> do
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar forall a b. ZipState a b
Empty
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
a, b
b))
ZipState a b
Done -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
ZipState a b
_ -> forall a. STM a
STM.retry )
case Maybe (a, b)
y of
Maybe (a, b)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return x
x
Just (a, b)
ab -> do
x
x' <- x -> (a, b) -> IO x
stepAB x
x (a, b)
ab
x -> IO x
loop forall a b. (a -> b) -> a -> b
$! x
x'
x
x' <- x -> IO x
loop forall a b. (a -> b) -> a -> b
$! x
beginAB
forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async ()
asyncA
forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async ()
asyncB
x -> IO b
doneAB x
x' ) )
endless :: Shell ()
endless :: Shell ()
endless = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> () -> IO x
step x
begin x -> IO r
_) -> do
let loop :: x -> IO b
loop x
x = do
x
x' <- x -> () -> IO x
step x
x ()
x -> IO b
loop forall a b. (a -> b) -> a -> b
$! x
x'
forall {b}. x -> IO b
loop forall a b. (a -> b) -> a -> b
$! x
begin )
limit :: Int -> Shell a -> Shell a
limit :: forall a. Int -> Shell a -> Shell a
limit Int
n Shell a
s = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> a -> IO x
step x
begin x -> IO r
done) -> do
IORef Int
ref <- forall a. a -> IO (IORef a)
newIORef Int
0
let step' :: x -> a -> IO x
step' x
x a
a = do
Int
n' <- forall a. IORef a -> IO a
readIORef IORef Int
ref
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
if Int
n' forall a. Ord a => a -> a -> Bool
< Int
n then x -> a -> IO x
step x
x a
a else forall (m :: * -> *) a. Monad m => a -> m a
return x
x
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step' x
begin x -> IO r
done) )
limitWhile :: (a -> Bool) -> Shell a -> Shell a
limitWhile :: forall a. (a -> Bool) -> Shell a -> Shell a
limitWhile a -> Bool
predicate Shell a
s = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> a -> IO x
step x
begin x -> IO r
done) -> do
IORef Bool
ref <- forall a. a -> IO (IORef a)
newIORef Bool
True
let step' :: x -> a -> IO x
step' x
x a
a = do
Bool
b <- forall a. IORef a -> IO a
readIORef IORef Bool
ref
let b' :: Bool
b' = Bool
b Bool -> Bool -> Bool
&& a -> Bool
predicate a
a
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
b'
if Bool
b' then x -> a -> IO x
step x
x a
a else forall (m :: * -> *) a. Monad m => a -> m a
return x
x
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step' x
begin x -> IO r
done) )
cache :: (Read a, Show a) => FilePath -> Shell a -> Shell a
cache :: forall a. (Read a, Show a) => FilePath -> Shell a -> Shell a
cache FilePath
file Shell a
s = do
let cached :: Shell (Maybe a)
cached = do
Line
line <- FilePath -> Shell Line
input FilePath
file
case forall a. Read a => ReadS a
reads (Text -> FilePath
Text.unpack (Line -> Text
lineToText Line
line)) of
[(Maybe a
ma, FilePath
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
ma
[(Maybe a, FilePath)]
_ ->
forall (io :: * -> *) a. MonadIO io => Text -> io a
die (forall r. Format Text r -> r
format (Format (FilePath -> Text) (FilePath -> Text)
"cache: Invalid data stored in "forall b c a. Format b c -> Format a b -> Format a c
%forall a r. Show a => Format r (a -> r)
w) FilePath
file)
Bool
exists <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
[Maybe a]
mas <- forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold (if Bool
exists then Shell (Maybe a)
cached else forall (f :: * -> *) a. Alternative f => f a
empty) forall a. Fold a [a]
list
case [ () | Maybe a
Nothing <- [Maybe a]
mas ] of
()
_:[()]
_ -> forall (f :: * -> *) a. Foldable f => f a -> Shell a
select [ a
a | Just a
a <- [Maybe a]
mas ]
[()]
_ -> do
Handle
handle <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
writeonly FilePath
file)
let justs :: Shell a
justs = do
a
a <- Shell a
s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (FilePath -> Text
Text.pack (forall a. Show a => a -> FilePath
show (forall a. a -> Maybe a
Just a
a))))
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
let nothing :: Shell b
nothing = do
let n :: Maybe ()
n = forall a. Maybe a
Nothing :: Maybe ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (FilePath -> Text
Text.pack (forall a. Show a => a -> FilePath
show Maybe ()
n)))
forall (f :: * -> *) a. Alternative f => f a
empty
Shell a
justs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {b}. Shell b
nothing
parallel :: [IO a] -> Shell a
parallel :: forall a. [IO a] -> Shell a
parallel = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (managed :: * -> *) a.
MonadManaged managed =>
IO a -> managed (Async a)
fork forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a. Foldable f => f a -> Shell a
select forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait
cut :: Pattern a -> Text -> [Text]
cut :: forall a. Pattern a -> Text -> [Text]
cut Pattern a
pattern' Text
txt = forall a. [a] -> a
head (forall a. Pattern a -> Text -> [a]
match (forall a. Pattern a -> Pattern a
selfless Pattern Text
chars forall a b. Pattern a -> Pattern b -> Pattern [a]
`sepBy` Pattern a
pattern') Text
txt)
date :: MonadIO io => io UTCTime
date :: forall (io :: * -> *). MonadIO io => io UTCTime
date = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
datefile :: MonadIO io => FilePath -> io UTCTime
datefile :: forall (io :: * -> *). MonadIO io => FilePath -> io UTCTime
datefile FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO UTCTime
Directory.getModificationTime FilePath
path)
du :: MonadIO io => FilePath -> io Size
du :: forall (io :: * -> *). MonadIO io => FilePath -> io Size
du FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
Bool
isDir <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
path
Integer
size <- do
if Bool
isDir
then do
let sizes :: Shell Integer
sizes = do
FilePath
child <- FilePath -> Shell FilePath
lstree FilePath
path
Bool
True <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
child
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Integer
Directory.getFileSize FilePath
child)
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell Integer
sizes forall a. Num a => Fold a a
Control.Foldl.sum
else FilePath -> IO Integer
Directory.getFileSize FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Size
Size Integer
size) )
newtype Size = Size { Size -> Integer
_bytes :: Integer } deriving (Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Integer -> Size
Size -> Size
Size -> Size -> Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Size
$cfromInteger :: Integer -> Size
signum :: Size -> Size
$csignum :: Size -> Size
abs :: Size -> Size
$cabs :: Size -> Size
negate :: Size -> Size
$cnegate :: Size -> Size
* :: Size -> Size -> Size
$c* :: Size -> Size -> Size
- :: Size -> Size -> Size
$c- :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c+ :: Size -> Size -> Size
Num)
instance Show Size where
show :: Size -> FilePath
show = forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Integer
_bytes
sz :: Format r (Size -> r)
sz :: forall r. Format r (Size -> r)
sz = forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\(Size Integer
numBytes) ->
let (Integer
numKilobytes, Integer
remainingBytes ) = Integer
numBytes forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
(Integer
numMegabytes, Integer
remainingKilobytes) = Integer
numKilobytes forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
(Integer
numGigabytes, Integer
remainingMegabytes) = Integer
numMegabytes forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
(Integer
numTerabytes, Integer
remainingGigabytes) = Integer
numGigabytes forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
in if Integer
numKilobytes forall a. Ord a => a -> a -> Bool
<= Integer
0
then forall r. Format Text r -> r
format (forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" B" ) Integer
remainingBytes
else if Integer
numMegabytes forall a. Eq a => a -> a -> Bool
== Integer
0
then forall r. Format Text r -> r
format (forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."forall b c a. Format b c -> Format a b -> Format a c
%forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" KB") Integer
remainingKilobytes Integer
remainingBytes
else if Integer
numGigabytes forall a. Eq a => a -> a -> Bool
== Integer
0
then forall r. Format Text r -> r
format (forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."forall b c a. Format b c -> Format a b -> Format a c
%forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" MB") Integer
remainingMegabytes Integer
remainingKilobytes
else if Integer
numTerabytes forall a. Eq a => a -> a -> Bool
== Integer
0
then forall r. Format Text r -> r
format (forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."forall b c a. Format b c -> Format a b -> Format a c
%forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" GB") Integer
remainingGigabytes Integer
remainingMegabytes
else forall r. Format Text r -> r
format (forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."forall b c a. Format b c -> Format a b -> Format a c
%forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" TB") Integer
numTerabytes Integer
remainingGigabytes )
pattern B :: Integral n => n -> Size
pattern $bB :: forall n. Integral n => n -> Size
$mB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
B { forall n. Integral n => Size -> n
bytes } <- (fromInteger . _bytes -> bytes)
where
B = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# COMPLETE B #-}
pattern KB :: Integral n => n -> Size
pattern $bKB :: forall n. Integral n => n -> Size
$mKB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
KB { forall n. Integral n => Size -> n
kilobytes } <- (\(B n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> kilobytes)
where
KB = forall n. Integral n => n -> Size
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE KB #-}
pattern MB :: Integral n => n -> Size
pattern $bMB :: forall n. Integral n => n -> Size
$mMB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
MB { forall n. Integral n => Size -> n
megabytes } <- (\(KB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> megabytes)
where
MB = forall n. Integral n => n -> Size
KB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE MB #-}
pattern GB :: Integral n => n -> Size
pattern $bGB :: forall n. Integral n => n -> Size
$mGB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
GB { forall n. Integral n => Size -> n
gigabytes } <- (\(MB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> gigabytes)
where
GB = forall n. Integral n => n -> Size
MB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE GB #-}
pattern TB :: Integral n => n -> Size
pattern $bTB :: forall n. Integral n => n -> Size
$mTB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
TB { forall n. Integral n => Size -> n
terabytes } <- (\(GB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> terabytes)
where
TB = forall n. Integral n => n -> Size
GB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE TB #-}
pattern KiB :: Integral n => n -> Size
pattern $bKiB :: forall n. Integral n => n -> Size
$mKiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
KiB { forall n. Integral n => Size -> n
kibibytes } <- (\(B n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> kibibytes)
where
KiB = forall n. Integral n => n -> Size
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE KiB #-}
pattern MiB :: Integral n => n -> Size
pattern $bMiB :: forall n. Integral n => n -> Size
$mMiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
MiB { forall n. Integral n => Size -> n
mebibytes } <- (\(KiB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> mebibytes)
where
MiB = forall n. Integral n => n -> Size
KiB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE MiB #-}
pattern GiB :: Integral n => n -> Size
pattern $bGiB :: forall n. Integral n => n -> Size
$mGiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
GiB { forall n. Integral n => Size -> n
gibibytes } <- (\(MiB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> gibibytes)
where
GiB = forall n. Integral n => n -> Size
MiB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE GiB #-}
pattern TiB :: Integral n => n -> Size
pattern $bTiB :: forall n. Integral n => n -> Size
$mTiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
TiB { forall n. Integral n => Size -> n
tebibytes } <- (\(GiB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> tebibytes)
where
TiB = forall n. Integral n => n -> Size
GiB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE TiB #-}
bytes :: Integral n => Size -> n
kilobytes :: Integral n => Size -> n
megabytes :: Integral n => Size -> n
gigabytes :: Integral n => Size -> n
terabytes :: Integral n => Size -> n
kibibytes :: Integral n => Size -> n
mebibytes :: Integral n => Size -> n
gibibytes :: Integral n => Size -> n
tebibytes :: Integral n => Size -> n
countChars :: Integral n => Fold Line n
countChars :: forall n. Integral n => Fold Line n
countChars =
forall a b r. (a -> b) -> Fold b r -> Fold a r
premap Line -> Text
lineToText forall n. Num n => Fold Text n
Control.Foldl.Text.length forall a. Num a => a -> a -> a
+
forall a. Num a => a
charsPerNewline forall a. Num a => a -> a -> a
* forall n. Integral n => Fold Line n
countLines
charsPerNewline :: Num a => a
#ifdef mingw32_HOST_OS
charsPerNewline = 2
#else
charsPerNewline :: forall a. Num a => a
charsPerNewline = a
1
#endif
countWords :: Integral n => Fold Line n
countWords :: forall n. Integral n => Fold Line n
countWords = forall a b r. (a -> b) -> Fold b r -> Fold a r
premap (Text -> [Text]
Text.words forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Text
lineToText) (forall a b r. Handler a b -> Fold b r -> Fold a r
handles forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b a. Num b => Fold a b
genericLength)
countLines :: Integral n => Fold Line n
countLines :: forall n. Integral n => Fold Line n
countLines = forall b a. Num b => Fold a b
genericLength
stat :: MonadIO io => FilePath -> io PosixCompat.FileStatus
stat :: forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
stat = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
PosixCompat.getFileStatus
fileSize :: PosixCompat.FileStatus -> Size
fileSize :: FileStatus -> Size
fileSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
PosixCompat.fileSize
accessTime :: PosixCompat.FileStatus -> POSIXTime
accessTime :: FileStatus -> POSIXTime
accessTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.accessTime
modificationTime :: PosixCompat.FileStatus -> POSIXTime
modificationTime :: FileStatus -> POSIXTime
modificationTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.modificationTime
statusChangeTime :: PosixCompat.FileStatus -> POSIXTime
statusChangeTime :: FileStatus -> POSIXTime
statusChangeTime = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.statusChangeTime
lstat :: MonadIO io => FilePath -> io PosixCompat.FileStatus
lstat :: forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
PosixCompat.getSymbolicLinkStatus
data a
= a
| Row a a
deriving (Int -> WithHeader a -> ShowS
forall a. Show a => Int -> WithHeader a -> ShowS
forall a. Show a => [WithHeader a] -> ShowS
forall a. Show a => WithHeader a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WithHeader a] -> ShowS
$cshowList :: forall a. Show a => [WithHeader a] -> ShowS
show :: WithHeader a -> FilePath
$cshow :: forall a. Show a => WithHeader a -> FilePath
showsPrec :: Int -> WithHeader a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithHeader a -> ShowS
Show)
data Pair a b = Pair !a !b
header :: Shell a -> Shell (WithHeader a)
(Shell forall r. FoldShell a r -> IO r
k) = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b}. FoldShell (WithHeader a) b -> IO b
k'
where
k' :: FoldShell (WithHeader a) b -> IO b
k' (FoldShell x -> WithHeader a -> IO x
step x
begin x -> IO b
done) = forall r. FoldShell a r -> IO r
k (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell Pair x (Maybe a) -> a -> IO (Pair x (Maybe a))
step' forall {a}. Pair x (Maybe a)
begin' forall {b}. Pair x b -> IO b
done')
where
step' :: Pair x (Maybe a) -> a -> IO (Pair x (Maybe a))
step' (Pair x
x Maybe a
Nothing ) a
a = do
x
x' <- x -> WithHeader a -> IO x
step x
x (forall a. a -> WithHeader a
Header a
a)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair x
x' (forall a. a -> Maybe a
Just a
a))
step' (Pair x
x (Just a
a)) a
b = do
x
x' <- x -> WithHeader a -> IO x
step x
x (forall a. a -> a -> WithHeader a
Row a
a a
b)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair x
x' (forall a. a -> Maybe a
Just a
a))
begin' :: Pair x (Maybe a)
begin' = forall a b. a -> b -> Pair a b
Pair x
begin forall a. Maybe a
Nothing
done' :: Pair x b -> IO b
done' (Pair x
x b
_) = x -> IO b
done x
x
single :: MonadIO io => Shell a -> io a
single :: forall (io :: * -> *) a. MonadIO io => Shell a -> io a
single Shell a
s = do
[a]
as <- forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell a
s forall a. Fold a [a]
Control.Foldl.list
case [a]
as of
[a
a] -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
[a]
_ -> do
let msg :: Text
msg = forall r. Format Text r -> r
format (Format (Int -> Text) (Int -> Text)
"single: expected 1 line of input but there were "forall b c a. Format b c -> Format a b -> Format a c
%forall n r. Integral n => Format r (n -> r)
dforall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" lines of input") (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as)
forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
msg
uniq :: Eq a => Shell a -> Shell a
uniq :: forall a. Eq a => Shell a -> Shell a
uniq = forall b a. Eq b => (a -> b) -> Shell a -> Shell a
uniqOn forall a. a -> a
id
uniqOn :: Eq b => (a -> b) -> Shell a -> Shell a
uniqOn :: forall b a. Eq b => (a -> b) -> Shell a -> Shell a
uniqOn a -> b
f = forall a. (a -> a -> Bool) -> Shell a -> Shell a
uniqBy (\a
a a
a' -> a -> b
f a
a forall a. Eq a => a -> a -> Bool
== a -> b
f a
a')
uniqBy :: (a -> a -> Bool) -> Shell a -> Shell a
uniqBy :: forall a. (a -> a -> Bool) -> Shell a -> Shell a
uniqBy a -> a -> Bool
cmp Shell a
s = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall a b. (a -> b) -> a -> b
$ \(FoldShell x -> a -> IO x
step x
begin x -> IO r
done) -> do
let step' :: (x, Maybe a) -> a -> IO (x, Maybe a)
step' (x
x, Just a
a') a
a | a -> a -> Bool
cmp a
a a
a' = forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, forall a. a -> Maybe a
Just a
a)
step' (x
x, Maybe a
_) a
a = (, forall a. a -> Maybe a
Just a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> a -> IO x
step x
x a
a
begin' :: (x, Maybe a)
begin' = (x
begin, forall a. Maybe a
Nothing)
done' :: (x, b) -> IO r
done' (x
x, b
_) = x -> IO r
done x
x
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> FoldShell a b -> io b
foldShell Shell a
s (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell (x, Maybe a) -> a -> IO (x, Maybe a)
step' forall {a}. (x, Maybe a)
begin' forall {b}. (x, b) -> IO r
done')
nub :: Ord a => Shell a -> Shell a
nub :: forall a. Ord a => Shell a -> Shell a
nub = forall b a. Ord b => (a -> b) -> Shell a -> Shell a
nubOn forall a. a -> a
id
nubOn :: Ord b => (a -> b) -> Shell a -> Shell a
nubOn :: forall b a. Ord b => (a -> b) -> Shell a -> Shell a
nubOn a -> b
f Shell a
s = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall a b. (a -> b) -> a -> b
$ \(FoldShell x -> a -> IO x
step x
begin x -> IO r
done) -> do
let step' :: (x, Set b) -> a -> IO (x, Set b)
step' (x
x, Set b
bs) a
a | forall a. Ord a => a -> Set a -> Bool
Set.member (a -> b
f a
a) Set b
bs = forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, Set b
bs)
| Bool
otherwise = (, forall a. Ord a => a -> Set a -> Set a
Set.insert (a -> b
f a
a) Set b
bs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> a -> IO x
step x
x a
a
begin' :: (x, Set a)
begin' = (x
begin, forall a. Set a
Set.empty)
done' :: (x, b) -> IO r
done' (x
x, b
_) = x -> IO r
done x
x
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> FoldShell a b -> io b
foldShell Shell a
s (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell (x, Set b) -> a -> IO (x, Set b)
step' forall {a}. (x, Set a)
begin' forall {b}. (x, b) -> IO r
done')
sort :: (Functor io, MonadIO io, Ord a) => Shell a -> io [a]
sort :: forall (io :: * -> *) a.
(Functor io, MonadIO io, Ord a) =>
Shell a -> io [a]
sort = forall (io :: * -> *) b a.
(Functor io, MonadIO io, Ord b) =>
(a -> b) -> Shell a -> io [a]
sortOn forall a. a -> a
id
sortOn :: (Functor io, MonadIO io, Ord b) => (a -> b) -> Shell a -> io [a]
sortOn :: forall (io :: * -> *) b a.
(Functor io, MonadIO io, Ord b) =>
(a -> b) -> Shell a -> io [a]
sortOn a -> b
f = forall (io :: * -> *) a.
(Functor io, MonadIO io) =>
(a -> a -> Ordering) -> Shell a -> io [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f)
sortBy :: (Functor io, MonadIO io) => (a -> a -> Ordering) -> Shell a -> io [a]
sortBy :: forall (io :: * -> *) a.
(Functor io, MonadIO io) =>
(a -> a -> Ordering) -> Shell a -> io [a]
sortBy a -> a -> Ordering
f Shell a
s = forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy a -> a -> Ordering
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell a
s forall a. Fold a [a]
list
toLines :: Shell Text -> Shell Line
toLines :: Shell Text -> Shell Line
toLines (Shell forall r. FoldShell Text r -> IO r
k) = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b}. FoldShell Line b -> IO b
k'
where
k' :: FoldShell Line b -> IO b
k' (FoldShell x -> Line -> IO x
step x
begin x -> IO b
done) =
forall r. FoldShell Text r -> IO r
k (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell Pair x Line -> Text -> IO (Pair x Line)
step' Pair x Line
begin' Pair x Line -> IO b
done')
where
step' :: Pair x Line -> Text -> IO (Pair x Line)
step' (Pair x
x Line
prefix) Text
text = do
let Line
suffix :| [Line]
lines = Text -> NonEmpty Line
Turtle.Line.textToLines Text
text
let line :: Line
line = Line
prefix forall a. Semigroup a => a -> a -> a
<> Line
suffix
let lines' :: NonEmpty Line
lines' = Line
line forall a. a -> [a] -> NonEmpty a
:| [Line]
lines
x
x' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM x -> Line -> IO x
step x
x (forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Line
lines')
let prefix' :: Line
prefix' = forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Line
lines'
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair x
x' Line
prefix')
begin' :: Pair x Line
begin' = (forall a b. a -> b -> Pair a b
Pair x
begin Line
"")
done' :: Pair x Line -> IO b
done' (Pair x
x Line
prefix) = do
x
x' <- x -> Line -> IO x
step x
x Line
prefix
x -> IO b
done x
x'