{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE ViewPatterns               #-}

-- | This module provides a large suite of utilities that resemble Unix
--  utilities.
--
--  Many of these commands are just existing Haskell commands renamed to match
--  their Unix counterparts:
--
-- >>> :set -XOverloadedStrings
-- >>> cd "/tmp"
-- >>> pwd
-- FilePath "/tmp"
--
-- Some commands are `Shell`s that emit streams of values.  `view` prints all
-- values in a `Shell` stream:
--
-- >>> view (ls "/usr")
-- FilePath "/usr/lib"
-- FilePath "/usr/src"
-- FilePath "/usr/sbin"
-- FilePath "/usr/include"
-- FilePath "/usr/share"
-- FilePath "/usr/games"
-- FilePath "/usr/local"
-- FilePath "/usr/bin"
-- >>> view (find (suffix "Browser.py") "/usr/lib")
-- FilePath "/usr/lib/python3.4/idlelib/ClassBrowser.py"
-- FilePath "/usr/lib/python3.4/idlelib/RemoteObjectBrowser.py"
-- FilePath "/usr/lib/python3.4/idlelib/PathBrowser.py"
-- FilePath "/usr/lib/python3.4/idlelib/ObjectBrowser.py"
--
-- Use `fold` to reduce the output of a `Shell` stream:
--
-- >>> import qualified Control.Foldl as Fold
-- >>> fold (ls "/usr") Fold.length
-- 8
-- >>> fold (find (suffix "Browser.py") "/usr/lib") Fold.head
-- Just (FilePath "/usr/lib/python3.4/idlelib/ClassBrowser.py")
--
-- Create files using `output`:
--
-- >>> output "foo.txt" ("123" <|> "456" <|> "ABC")
-- >>> realpath "foo.txt"
-- FilePath "/tmp/foo.txt"
--
-- Read in files using `input`:
--
-- >>> stdout (input "foo.txt")
-- 123
-- 456
-- ABC
--
-- Format strings in a type safe way using `format`:
--
-- >>> dir <- pwd
-- >>> format ("I am in the "%fp%" directory") dir
-- "I am in the /tmp directory"
--
-- Commands like `grep`, `sed` and `find` accept arbitrary `Pattern`s
--
-- >>> stdout (grep ("123" <|> "ABC") (input "foo.txt"))
-- 123
-- ABC
-- >>> let exclaim = fmap (<> "!") (plus digit)
-- >>> stdout (sed exclaim (input "foo.txt"))
-- 123!
-- 456!
-- ABC
--
-- Note that `grep` and `find` differ from their Unix counterparts by requiring
-- that the `Pattern` matches the entire line or file name by default.  However,
-- you can optionally match the prefix, suffix, or interior of a line:
--
-- >>> stdout (grep (has    "2") (input "foo.txt"))
-- 123
-- >>> stdout (grep (prefix "1") (input "foo.txt"))
-- 123
-- >>> stdout (grep (suffix "3") (input "foo.txt"))
-- 123
--
--  You can also build up more sophisticated `Shell` programs using `sh` in
--  conjunction with @do@ notation:
--
-- >{-# LANGUAGE OverloadedStrings #-}
-- >
-- >import Turtle
-- >
-- >main = sh example
-- >
-- >example = do
-- >    -- Read in file names from "files1.txt" and "files2.txt"
-- >    file <- fmap fromText (input "files1.txt" <|> input "files2.txt")
-- >
-- >    -- Stream each file to standard output only if the file exists
-- >    True <- liftIO (testfile file)
-- >    line <- input file
-- >    liftIO (echo line)
--
-- See "Turtle.Tutorial" for an extended tutorial explaining how to use this
-- library in greater detail.

module Turtle.Prelude (
    -- * IO
      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
    , (.&&.)
    , (.||.)

    -- * Managed
    , readonly
    , writeonly
    , appendonly
    , mktemp
    , mktempfile
    , mktempdir
    , fork
    , wait
    , pushd

    -- * Shell
    , 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

    -- * Folds
    , countChars
    , countWords
    , countLines

    -- * Text
    , cut

    -- * Subprocess management
    , proc
    , shell
    , procs
    , shells
    , inproc
    , inshell
    , inprocWithErr
    , inshellWithErr
    , procStrict
    , shellStrict
    , procStrictWithErr
    , shellStrictWithErr

    , system
    , stream
    , streamWithErr
    , systemStrict
    , systemStrictWithErr

    -- * Permissions
    , Permissions(..)
    , chmod
    , getmod
    , setmod
    , copymod
    , readable, nonreadable
    , writable, nonwritable
    , executable, nonexecutable
    , ooo,roo,owo,oox,rwo,rox,owx,rwx

    -- * File size
    , du
    , Size(B, KB, MB, GB, TB, KiB, MiB, GiB, TiB)
    , sz
    , bytes
    , kilobytes
    , megabytes
    , gigabytes
    , terabytes
    , kibibytes
    , mebibytes
    , gibibytes
    , tebibytes

    -- * File status
    , PosixCompat.FileStatus
    , stat
    , lstat
    , fileSize
    , accessTime
    , modificationTime
    , statusChangeTime
    , PosixCompat.isBlockDevice
    , PosixCompat.isCharacterDevice
    , PosixCompat.isNamedPipe
    , PosixCompat.isRegularFile
    , PosixCompat.isDirectory
    , PosixCompat.isSymbolicLink
    , PosixCompat.isSocket
    , cmin
    , cmax

    -- * Headers
    , WithHeader(..)
    , header

    -- * Exceptions
    , 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

{-| Run a command using @execvp@, retrieving the exit code

    The command inherits @stdout@ and @stderr@ for the current process
-}
proc
    :: MonadIO io
    => Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> io ExitCode
    -- ^ Exit code
proc :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ExitCode
proc Text
cmd [Text]
args =
    CreateProcess -> Shell Line -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io ExitCode
system
        ( (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.Inherit
            , Process.std_err = Process.Inherit
            } )

{-| Run a command line using the shell, retrieving the exit code

    This command is more powerful than `proc`, but highly vulnerable to code
    injection if you template the command line with untrusted input

    The command inherits @stdout@ and @stderr@ for the current process
-}
shell
    :: MonadIO io
    => Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> io ExitCode
    -- ^ Exit code
shell :: forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io ExitCode
shell Text
cmdLine =
    CreateProcess -> Shell Line -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io ExitCode
system
        ( (FilePath -> CreateProcess
Process.shell (Text -> FilePath
unpack Text
cmdLine))
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.Inherit
            , Process.std_err = 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
(Int -> ProcFailed -> ShowS)
-> (ProcFailed -> FilePath)
-> ([ProcFailed] -> ShowS)
-> Show ProcFailed
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcFailed -> ShowS
showsPrec :: Int -> ProcFailed -> ShowS
$cshow :: ProcFailed -> FilePath
show :: ProcFailed -> FilePath
$cshowList :: [ProcFailed] -> ShowS
showList :: [ProcFailed] -> ShowS
Show, Typeable)

instance Exception ProcFailed

{-| This function is identical to `proc` except this throws `ProcFailed` for
    non-zero exit codes
-}
procs
    :: MonadIO io
    => Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> io ()
procs :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ()
procs Text
cmd [Text]
args Shell Line
s = do
    exitCode <- Text -> [Text] -> Shell Line -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ExitCode
proc Text
cmd [Text]
args Shell Line
s
    case exitCode of
        ExitCode
ExitSuccess -> () -> io ()
forall a. a -> io a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitCode
_           -> IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcFailed -> IO ()
forall e a. (HasCallStack, 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
(Int -> ShellFailed -> ShowS)
-> (ShellFailed -> FilePath)
-> ([ShellFailed] -> ShowS)
-> Show ShellFailed
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShellFailed -> ShowS
showsPrec :: Int -> ShellFailed -> ShowS
$cshow :: ShellFailed -> FilePath
show :: ShellFailed -> FilePath
$cshowList :: [ShellFailed] -> ShowS
showList :: [ShellFailed] -> ShowS
Show, Typeable)

instance Exception ShellFailed

{-| This function is identical to `shell` except this throws `ShellFailed` for
    non-zero exit codes
-}
shells
    :: MonadIO io
    => Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> io ()
    -- ^ Exit code
shells :: forall (io :: * -> *). MonadIO io => Text -> Shell Line -> io ()
shells Text
cmdline Shell Line
s = do
    exitCode <- Text -> Shell Line -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io ExitCode
shell Text
cmdline Shell Line
s
    case exitCode of
        ExitCode
ExitSuccess -> () -> io ()
forall a. a -> io a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitCode
_           -> IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ShellFailed -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (Text -> ExitCode -> ShellFailed
ShellFailed Text
cmdline ExitCode
exitCode))

{-| Run a command using @execvp@, retrieving the exit code and stdout as a
    non-lazy blob of Text

    The command inherits @stderr@ for the current process
-}
procStrict
    :: MonadIO io
    => Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> io (ExitCode, Text)
    -- ^ Exit code and stdout
procStrict :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io (ExitCode, Text)
procStrict Text
cmd [Text]
args =
    CreateProcess -> Shell Line -> io (ExitCode, Text)
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack [Text]
args))

{-| Run a command line using the shell, retrieving the exit code and stdout as a
    non-lazy blob of Text

    This command is more powerful than `proc`, but highly vulnerable to code
    injection if you template the command line with untrusted input

    The command inherits @stderr@ for the current process
-}
shellStrict
    :: MonadIO io
    => Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> io (ExitCode, Text)
    -- ^ Exit code and stdout
shellStrict :: forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io (ExitCode, Text)
shellStrict Text
cmdLine = CreateProcess -> Shell Line -> io (ExitCode, Text)
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Text.unpack Text
cmdLine))

{-| Run a command using @execvp@, retrieving the exit code, stdout, and stderr
    as a non-lazy blob of Text
-}
procStrictWithErr
    :: MonadIO io
    => Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> io (ExitCode, Text, Text)
    -- ^ (Exit code, stdout, stderr)
procStrictWithErr :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io (ExitCode, Text, Text)
procStrictWithErr Text
cmd [Text]
args =
    CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack [Text]
args))

{-| Run a command line using the shell, retrieving the exit code, stdout, and
    stderr as a non-lazy blob of Text

    This command is more powerful than `proc`, but highly vulnerable to code
    injection if you template the command line with untrusted input
-}
shellStrictWithErr
    :: MonadIO io
    => Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> io (ExitCode, Text, Text)
    -- ^ (Exit code, stdout, stderr)
shellStrictWithErr :: forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io (ExitCode, Text, Text)
shellStrictWithErr Text
cmdLine =
    CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Text.unpack Text
cmdLine))

-- | Halt an `Async` thread, re-raising any exceptions it might have thrown
halt :: Async a -> IO ()
halt :: forall a. Async a -> IO ()
halt Async a
a = do
    m <- Async a -> IO (Maybe (Either SomeException a))
forall a. Async a -> IO (Maybe (Either SomeException a))
Control.Concurrent.Async.poll Async a
a
    case m of
        Maybe (Either SomeException a)
Nothing        -> Async a -> IO ()
forall a. Async a -> IO ()
Control.Concurrent.Async.cancel Async a
a
        Just (Left  SomeException
e) -> SomeException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO SomeException
e
        Just (Right a
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-| `system` generalizes `shell` and `proc` by allowing you to supply your own
    custom `CreateProcess`.  This is for advanced users who feel comfortable
    using the lower-level @process@ API
-}
system
    :: MonadIO io
    => Process.CreateProcess
    -- ^ Command
    -> Shell Line
    -- ^ Lines of standard input
    -> io ExitCode
    -- ^ Exit code
system :: forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io ExitCode
system CreateProcess
p Shell Line
s = IO ExitCode -> io ExitCode
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let open :: IO (Maybe Handle, ProcessHandle)
open = do
            (m, Nothing, Nothing, ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p
            case m of
                Just Handle
hIn -> Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
                Maybe Handle
_        -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            return (m, ph)

    -- Prevent double close
    mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
    let close Handle
handle = do
            MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
                Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
    let 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 (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 =
                    IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> Shell Line -> IO ()
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
            ((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
                IO () -> (Async () -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn IO a -> IO a
forall a. IO a -> IO a
restore) (\Async ()
a ->
                    IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
restore (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph) IO ExitCode -> IO () -> IO ExitCode
forall a b. IO a -> IO b -> IO a
`finally` Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a) )
        handle (Maybe Handle
Nothing , ProcessHandle
ph) = do
            ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph

    bracket open close' handle )


{-| `systemStrict` generalizes `shellStrict` and `procStrict` by allowing you to
    supply your own custom `CreateProcess`.  This is for advanced users who feel
    comfortable using the lower-level @process@ API
-}
systemStrict
    :: MonadIO io
    => Process.CreateProcess
    -- ^ Command
    -> Shell Line
    -- ^ Lines of standard input
    -> io (ExitCode, Text)
    -- ^ Exit code and stdout
systemStrict :: forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict CreateProcess
p Shell Line
s = IO (ExitCode, Text) -> io (ExitCode, Text)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let p' :: CreateProcess
p' = CreateProcess
p
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.CreatePipe
            , Process.std_err = Process.Inherit
            }

    let open :: IO (Handle, Handle, ProcessHandle)
open = do
            (Just hIn, Just hOut, Nothing, ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
            IO.hSetBuffering hIn IO.LineBuffering
            return (hIn, hOut, ph)

    -- Prevent double close
    mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
    let close Handle
handle = do
            MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
                Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    bracket open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 =
                IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> Shell Line -> IO ()
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

        IO ExitCode -> IO Text -> IO (ExitCode, Text)
forall a b. IO a -> IO b -> IO (a, b)
concurrently
            (((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
                IO () -> (Async () -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn IO a -> IO a
forall a. IO a -> IO a
restore) (\Async ()
a ->
                    IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
restore (IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph)) IO ExitCode -> IO () -> IO ExitCode
forall a b. IO a -> IO b -> IO a
`finally` Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a ) ))
            (Handle -> IO Text
Text.hGetContents Handle
hOut) ) )

{-| `systemStrictWithErr` generalizes `shellStrictWithErr` and
    `procStrictWithErr` by allowing you to supply your own custom
    `CreateProcess`.  This is for advanced users who feel comfortable using
    the lower-level @process@ API
-}
systemStrictWithErr
    :: MonadIO io
    => Process.CreateProcess
    -- ^ Command
    -> Shell Line
    -- ^ Lines of standard input
    -> io (ExitCode, Text, Text)
    -- ^ Exit code and stdout
systemStrictWithErr :: forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr CreateProcess
p Shell Line
s = IO (ExitCode, Text, Text) -> io (ExitCode, Text, Text)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let p' :: CreateProcess
p' = CreateProcess
p
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.CreatePipe
            , Process.std_err = Process.CreatePipe
            }

    let open :: IO (Handle, Handle, Handle, ProcessHandle)
open = do
            (Just hIn, Just hOut, Just hErr, ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
            IO.hSetBuffering hIn IO.LineBuffering
            return (hIn, hOut, hErr, ph)

    -- Prevent double close
    mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
    let close Handle
handle = do
            MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
                Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    bracket open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 =
                IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> Shell Line -> IO ()
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

        Concurrently (ExitCode, Text, Text) -> IO (ExitCode, Text, Text)
forall a. Concurrently a -> IO a
runConcurrently (Concurrently (ExitCode, Text, Text) -> IO (ExitCode, Text, Text))
-> Concurrently (ExitCode, Text, Text) -> IO (ExitCode, Text, Text)
forall a b. (a -> b) -> a -> b
$ (,,)
            (ExitCode -> Text -> Text -> (ExitCode, Text, Text))
-> Concurrently ExitCode
-> Concurrently (Text -> Text -> (ExitCode, Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ExitCode -> Concurrently ExitCode
forall a. IO a -> Concurrently a
Concurrently (((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
                    IO () -> (Async () -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn IO a -> IO a
forall a. IO a -> IO a
restore) (\Async ()
a ->
                        IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
restore (IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph)) IO ExitCode -> IO () -> IO ExitCode
forall a b. IO a -> IO b -> IO a
`finally` Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a ) ))
            Concurrently (Text -> Text -> (ExitCode, Text, Text))
-> Concurrently Text
-> Concurrently (Text -> (ExitCode, Text, Text))
forall a b.
Concurrently (a -> b) -> Concurrently a -> Concurrently b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text -> Concurrently Text
forall a. IO a -> Concurrently a
Concurrently (Handle -> IO Text
Text.hGetContents Handle
hOut)
            Concurrently (Text -> (ExitCode, Text, Text))
-> Concurrently Text -> Concurrently (ExitCode, Text, Text)
forall a b.
Concurrently (a -> b) -> Concurrently a -> Concurrently b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Text -> Concurrently Text
forall a. IO a -> Concurrently a
Concurrently (Handle -> IO Text
Text.hGetContents Handle
hErr) ) )

{-| Run a command using @execvp@, streaming @stdout@ as lines of `Text`

    The command inherits @stderr@ for the current process
-}
inproc
    :: Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell Line
    -- ^ Lines of standard output
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) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))

{-| Run a command line using the shell, streaming @stdout@ as lines of `Text`

    This command is more powerful than `inproc`, but highly vulnerable to code
    injection if you template the command line with untrusted input

    The command inherits @stderr@ for the current process

    Throws an `ExitCode` exception if the command returns a non-zero exit code
-}
inshell
    :: Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell Line
    -- ^ Lines of standard output
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 <- ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph
    case exitCode of
        ExitCode
ExitSuccess   -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitFailure Int
_ -> ExitCode -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
Control.Exception.throwIO ExitCode
exitCode

{-| `stream` generalizes `inproc` and `inshell` by allowing you to supply your
    own custom `CreateProcess`.  This is for advanced users who feel comfortable
    using the lower-level @process@ API

    Throws an `ExitCode` exception if the command returns a non-zero exit code
-}
stream
    :: Process.CreateProcess
    -- ^ Command
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell Line
    -- ^ Lines of standard output
stream :: CreateProcess -> Shell Line -> Shell Line
stream CreateProcess
p Shell Line
s = do
    let p' :: CreateProcess
p' = CreateProcess
p
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.CreatePipe
            , Process.std_err = Process.Inherit
            }

    let open :: IO (Handle, Handle, ProcessHandle)
open = do
            (Just hIn, Just hOut, Nothing, ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
            IO.hSetBuffering hIn IO.LineBuffering
            return (hIn, hOut, ph)

    -- Prevent double close
    mvar <- IO (MVar Bool) -> Shell (MVar Bool)
forall a. IO a -> Shell a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False)
    let close Handle
handle = do
            MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
                Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    (hIn, hOut, ph) <- using (managed (bracket open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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
restore = IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> Shell Line -> IO ()
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

    a <- using
        (managed (\Async () -> IO r
k ->
            ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn IO a -> IO a
forall a. IO a -> IO a
restore) (IO r -> IO r
forall a. IO a -> IO a
restore (IO r -> IO r) -> (Async () -> IO r) -> Async () -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k))))
    inhandle hOut <|> (liftIO (waitForProcessThrows ph *> halt a) *> empty)

{-| `streamWithErr` generalizes `inprocWithErr` and `inshellWithErr` by allowing
    you to supply your own custom `CreateProcess`.  This is for advanced users
    who feel comfortable using the lower-level @process@ API

    Throws an `ExitCode` exception if the command returns a non-zero exit code
-}
streamWithErr
    :: Process.CreateProcess
    -- ^ Command
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell (Either Line Line)
    -- ^ Lines of standard output
streamWithErr :: CreateProcess -> Shell Line -> Shell (Either Line Line)
streamWithErr CreateProcess
p Shell Line
s = do
    let p' :: CreateProcess
p' = CreateProcess
p
            { Process.std_in  = Process.CreatePipe
            , Process.std_out = Process.CreatePipe
            , Process.std_err = Process.CreatePipe
            }

    let open :: IO (Handle, Handle, Handle, ProcessHandle)
open = do
            (Just hIn, Just hOut, Just hErr, ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
            IO.hSetBuffering hIn IO.LineBuffering
            return (hIn, hOut, hErr, ph)

    -- Prevent double close
    mvar <- IO (MVar Bool) -> Shell (MVar Bool)
forall a. IO a -> Shell a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False)
    let close Handle
handle = do
            MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
                Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    (hIn, hOut, hErr, ph) <- using (managed (bracket open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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
restore = IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> Shell Line -> IO ()
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

    queue <- liftIO TQueue.newTQueueIO
    let forwardOut :: (forall a. IO a -> IO a) -> IO ()
        forwardOut forall a. IO a -> IO a
restore =
            IO () -> IO ()
forall a. IO a -> IO a
restore (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
                line <- Handle -> Shell Line
inhandle Handle
hOut
                liftIO (STM.atomically (TQueue.writeTQueue queue (Just (Right line)))) ))
            IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either Line Line))
-> Maybe (Either Line Line) -> STM ()
forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either Line Line))
queue Maybe (Either Line Line)
forall a. Maybe a
Nothing)
    let forwardErr :: (forall a. IO a -> IO a) -> IO ()
        forwardErr forall a. IO a -> IO a
restore =
            IO () -> IO ()
forall a. IO a -> IO a
restore (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
                line <- Handle -> Shell Line
inhandle Handle
hErr
                liftIO (STM.atomically (TQueue.writeTQueue queue (Just (Left  line)))) ))
            IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either Line Line))
-> Maybe (Either Line Line) -> STM ()
forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either Line Line))
queue Maybe (Either Line Line)
forall a. Maybe a
Nothing)
    let drain = (forall r. FoldShell (Either Line Line) r -> IO r)
-> Shell (Either Line Line)
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
2 = do
                        m <- STM (Maybe (Either Line Line)) -> IO (Maybe (Either Line Line))
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either Line Line)) -> STM (Maybe (Either Line Line))
forall a. TQueue a -> STM a
TQueue.readTQueue TQueue (Maybe (Either Line Line))
queue)
                        case m of
                            Maybe (Either Line Line)
Nothing -> x -> a -> IO x
loop x
x (a -> IO x) -> a -> IO x
forall a b. (a -> b) -> a -> b
$! a
numNothing a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
                            Just Either Line Line
e  -> do
                                x' <- x -> Either Line Line -> IO x
step x
x Either Line Line
e
                                loop x' numNothing
                    | Bool
otherwise      = x -> IO x
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
            x1 <- x -> Int -> IO x
forall {a}. (Ord a, Num a) => x -> a -> IO x
loop x
begin (Int
0 :: Int)
            done x1 )

    a <- using
        (managed (\Async () -> IO r
k ->
            ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn IO a -> IO a
forall a. IO a -> IO a
restore) (IO r -> IO r
forall a. IO a -> IO a
restore (IO r -> IO r) -> (Async () -> IO r) -> Async () -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k)) ))
    b <- using
        (managed (\Async () -> IO r
k ->
            ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
forwardOut IO a -> IO a
forall a. IO a -> IO a
restore) (IO r -> IO r
forall a. IO a -> IO a
restore (IO r -> IO r) -> (Async () -> IO r) -> Async () -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k)) ))
    c <- using
        (managed (\Async () -> IO r
k ->
            ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
forwardErr IO a -> IO a
forall a. IO a -> IO a
restore) (IO r -> IO r
forall a. IO a -> IO a
restore (IO r -> IO r) -> (Async () -> IO r) -> Async () -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k)) ))
    let STM a
l `also` STM a
r = do
            _ <- STM a
l STM a -> STM a -> STM a
forall a. STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (STM a
r STM a -> STM a -> STM a
forall a b. STM a -> STM b -> STM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> STM a
forall a. STM a
STM.retry)
            _ <- r
            return ()
    let waitAll = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (Async () -> STM ()
forall a. Async a -> STM a
waitSTM Async ()
a STM () -> STM () -> STM ()
forall {a} {a}. STM a -> STM a -> STM ()
`also` (Async () -> STM ()
forall a. Async a -> STM a
waitSTM Async ()
b STM () -> STM () -> STM ()
forall {a} {a}. STM a -> STM a -> STM ()
`also` Async () -> STM ()
forall a. Async a -> STM a
waitSTM Async ()
c))
    drain <|> (liftIO (waitForProcessThrows ph *> waitAll) *> empty)

{-| Run a command using the shell, streaming @stdout@ and @stderr@ as lines of
    `Text`.  Lines from @stdout@ are wrapped in `Right` and lines from @stderr@
    are wrapped in `Left`.

    Throws an `ExitCode` exception if the command returns a non-zero exit code
-}
inprocWithErr
    :: Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell (Either Line Line)
    -- ^ Lines of either standard output (`Right`) or standard error (`Left`)
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) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))

{-| Run a command line using the shell, streaming @stdout@ and @stderr@ as lines
    of `Text`.  Lines from @stdout@ are wrapped in `Right` and lines from
    @stderr@ are wrapped in `Left`.

    This command is more powerful than `inprocWithErr`, but highly vulnerable to
    code injection if you template the command line with untrusted input

    Throws an `ExitCode` exception if the command returns a non-zero exit code
-}
inshellWithErr
    :: Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell (Either Line Line)
    -- ^ Lines of either standard output (`Right`) or standard error (`Left`)
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))

{-| Print exactly one line to @stdout@

    To print more than one line see `Turtle.Format.printf`, which also supports
    formatted output
-}
echo :: MonadIO io => Line -> io ()
echo :: forall (io :: * -> *). MonadIO io => Line -> io ()
echo Line
line = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO ()
Text.putStrLn (Line -> Text
lineToText Line
line))

-- | Print exactly one line to @stderr@
err :: MonadIO io => Line -> io ()
err :: forall (io :: * -> *). MonadIO io => Line -> io ()
err Line
line = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
IO.stderr (Line -> Text
lineToText Line
line))

{-| Read in a line from @stdin@

    Returns `Nothing` if at end of input
-}
readline :: MonadIO io => io (Maybe Line)
readline :: forall (io :: * -> *). MonadIO io => io (Maybe Line)
readline = IO (Maybe Line) -> io (Maybe Line)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    eof <- IO Bool
IO.isEOF
    if eof
        then return Nothing
        else fmap (Just . unsafeTextToLine . pack) getLine )

-- | Get command line arguments in a list
arguments :: MonadIO io => io [Text]
arguments :: forall (io :: * -> *). MonadIO io => io [Text]
arguments = IO [Text] -> io [Text]
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (([FilePath] -> [Text]) -> IO [FilePath] -> IO [Text]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
pack) IO [FilePath]
getArgs)

#if __GLASGOW_HASKELL__ >= 710
{-| Set or modify an environment variable

    Note: This will change the current environment for all of your program's
    threads since this modifies the global state of the process
-}
export :: MonadIO io => Text -> Text -> io ()
export :: forall (io :: * -> *). MonadIO io => Text -> Text -> io ()
export Text
key Text
val = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO ()
setEnv (Text -> FilePath
unpack Text
key) (Text -> FilePath
unpack Text
val))

-- | Delete an environment variable
unset :: MonadIO io => Text -> io ()
unset :: forall (io :: * -> *). MonadIO io => Text -> io ()
unset Text
key = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
unsetEnv (Text -> FilePath
unpack Text
key))
#endif

-- | Look up an environment variable
need :: MonadIO io => Text -> io (Maybe Text)
#if __GLASGOW_HASKELL__ >= 708
need :: forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
need Text
key = IO (Maybe Text) -> io (Maybe Text)
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
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

-- | Retrieve all environment variables
env :: MonadIO io => io [(Text, Text)]
env :: forall (io :: * -> *). MonadIO io => io [(Text, Text)]
env = IO [(Text, Text)] -> io [(Text, Text)]
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (([(FilePath, FilePath)] -> [(Text, Text)])
-> IO [(FilePath, FilePath)] -> IO [(Text, Text)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((FilePath, FilePath) -> (Text, Text))
-> [(FilePath, FilePath)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
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)

{-| Change the current directory

    Note: This will change the current directory for all of your program's
    threads since this modifies the global state of the process
-}
cd :: MonadIO io => FilePath -> io ()
cd :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
cd FilePath
path = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.setCurrentDirectory FilePath
path)

{-| Change the current directory. Once the current 'Shell' is done, it returns
back to the original directory.

>>> :set -XOverloadedStrings
>>> cd "/"
>>> view (pushd "/tmp" >> pwd)
FilePath "/tmp"
>>> pwd
FilePath "/"
-}
pushd :: MonadManaged managed => FilePath -> managed ()
pushd :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed ()
pushd FilePath
path = do
    cwd <- managed FilePath
forall (io :: * -> *). MonadIO io => io FilePath
pwd
    using (managed_ (bracket_ (cd path) (cd cwd)))

-- | Get the current directory
pwd :: MonadIO io => io FilePath
pwd :: forall (io :: * -> *). MonadIO io => io FilePath
pwd = IO FilePath -> io FilePath
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
Directory.getCurrentDirectory

-- | Get the home directory
home :: MonadIO io => io FilePath
home :: forall (io :: * -> *). MonadIO io => io FilePath
home = IO FilePath -> io FilePath
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
Directory.getHomeDirectory

-- | Get the path pointed to by a symlink
readlink :: MonadIO io => FilePath -> io FilePath
readlink :: forall (io :: * -> *). MonadIO io => FilePath -> io FilePath
readlink FilePath
path = IO FilePath -> io FilePath
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
Directory.getSymbolicLinkTarget FilePath
path)

-- | Canonicalize a path
realpath :: MonadIO io => FilePath -> io FilePath
realpath :: forall (io :: * -> *). MonadIO io => FilePath -> io FilePath
realpath FilePath
path = IO FilePath -> io FilePath
forall a. IO a -> io a
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

{-| Stream all immediate children of the given directory, excluding @\".\"@ and
    @\"..\"@
-}
ls :: FilePath -> Shell FilePath
ls :: FilePath -> Shell FilePath
ls FilePath
path = (forall r. FoldShell FilePath r -> IO r) -> Shell FilePath
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
    canRead <- (Permissions -> Bool) -> IO Permissions -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
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 canRead
        then bracket (openDirStream path') closeDirStream (\DirStream
dirp -> do
            let loop :: x -> IO r
loop x
x = do
                    file <- DirStream -> IO FilePath
readDirStream DirStream
dirp
                    case file of
                        FilePath
"" -> x -> IO r
done x
x
                        FilePath
_  -> do
                            x' <- if (FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"..")
                                then x -> FilePath -> IO x
step x
x (FilePath
path FilePath -> ShowS
</> FilePath
file)
                                else x -> IO x
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
                            loop $! x'
            x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
begin )
        else done begin )
#endif

{-| This is used to remove the trailing slash from a path, because
    `getPermissions` will fail if a path ends with a trailing slash
-}
deslash :: String -> String
deslash :: ShowS
deslash []     = []
deslash (Char
c0:FilePath
cs0) = Char
c0Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
go FilePath
cs0
  where
    go :: ShowS
go []     = []
    go [Char
'\\'] = []
    go (Char
c:FilePath
cs) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
go FilePath
cs

-- | Stream all recursive descendents of the given directory
lstree :: FilePath -> Shell FilePath
lstree :: FilePath -> Shell FilePath
lstree FilePath
path = do
    child <- FilePath -> Shell FilePath
ls FilePath
path
    isDir <- testdir child
    if isDir
        then return child <|> lstree child
        else return child


{- | Stream the recursive descendents of a given directory
     between a given minimum and maximum depth
-}
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
u
      then Shell FilePath
forall a. Shell a
forall (f :: * -> *) a. Alternative f => f a
empty
      else do
        child <- FilePath -> Shell FilePath
ls FilePath
p
        isDir <- testdir child
        if isDir
          then if depth >= l
               then return child <|> lsdepthHelper (depth + 1) l u child
               else lsdepthHelper (depth + 1) l u child
          else if depth >= l
               then return child
               else empty

{-| Stream all recursive descendents of the given directory

    This skips any directories that fail the supplied predicate

> lstree = lsif (\_ -> return True)
-}
lsif :: (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif :: (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
predicate FilePath
path = do
    child <- FilePath -> Shell FilePath
ls FilePath
path
    isDir <- testdir child
    if isDir
        then do
            continue <- liftIO (predicate child)
            if continue
                then return child <|> lsif predicate child
                else return child
        else return child

{-| Move a file or directory

    Works if the two paths are on the same filesystem.
    If not, @mv@ will still work when dealing with a regular file,
    but the operation will not be atomic
-}
mv :: MonadIO io => FilePath -> FilePath -> io ()
mv :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
mv FilePath
oldPath FilePath
newPath = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ IO () -> (IOError -> IO ()) -> IO ()
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 IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
UnsupportedOperation -- certainly EXDEV
                then do
                    FilePath -> FilePath -> IO ()
Directory.copyFile FilePath
oldPath FilePath
newPath
                    FilePath -> IO ()
Directory.removeFile FilePath
oldPath
                else IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
ioe)

{-| Create a directory

    Fails if the directory is present
-}
mkdir :: MonadIO io => FilePath -> io ()
mkdir :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
mkdir FilePath
path = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.createDirectory FilePath
path)

{-| Create a directory tree (equivalent to @mkdir -p@)

    Does not fail if the directory is present
-}
mktree :: MonadIO io => FilePath -> io ()
mktree :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree FilePath
path = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
True FilePath
path)

-- | Copy a file
cp :: MonadIO io => FilePath -> FilePath -> io ()
cp :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cp FilePath
oldPath FilePath
newPath = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO ()
Directory.copyFile FilePath
oldPath FilePath
newPath)

#if !defined(mingw32_HOST_OS)
-- | Create a symlink from one @FilePath@ to another
symlink :: MonadIO io => FilePath -> FilePath -> io ()
symlink :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
symlink FilePath
a FilePath
b = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
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 (Text -> FilePath) -> (FilePath -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
fp 
  
#endif

{-| Returns `True` if the given `FilePath` is not a symbolic link

    This comes in handy in conjunction with `lsif`:

    > lsif isNotSymbolicLink
-}
isNotSymbolicLink :: MonadIO io => FilePath -> io Bool
isNotSymbolicLink :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
isNotSymbolicLink = (FileStatus -> Bool) -> io FileStatus -> io Bool
forall a b. (a -> b) -> io a -> io b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> (FileStatus -> Bool) -> FileStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
PosixCompat.isSymbolicLink) (io FileStatus -> io Bool)
-> (FilePath -> io FileStatus) -> FilePath -> io Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> io FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat

-- | Copy a directory tree and preserve symbolic links
cptree :: MonadIO io => FilePath -> FilePath -> io ()
cptree :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cptree FilePath
oldTree FilePath
newTree = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    oldPath <- (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
isNotSymbolicLink FilePath
oldTree

    -- The `system-filepath` library treats a path like "/tmp" as a file and not
    -- a directory and fails to strip it as a prefix from `/tmp/foo`.  Adding
    -- `(</> "")` to the end of the path makes clear that the path is a
    -- directory
    Just suffix <- return (Internal.stripPrefix (oldTree <> [ FilePath.pathSeparator ]) oldPath)

    let newPath = FilePath
newTree FilePath -> ShowS
</> FilePath
suffix

    isFile <- testfile oldPath

    fileStatus <- lstat oldPath

    if PosixCompat.isSymbolicLink fileStatus
        then do
            oldTarget <- liftIO (PosixCompat.readSymbolicLink oldPath)

            mktree (FilePath.takeDirectory newPath)

            liftIO (PosixCompat.createSymbolicLink oldTarget newPath)
        else if isFile
        then do
            mktree (FilePath.takeDirectory newPath)

            cp oldPath newPath
        else do
            mktree newPath )

-- | Copy a directory tree and dereference symbolic links
cptreeL :: MonadIO io => FilePath -> FilePath -> io ()
cptreeL :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cptreeL FilePath
oldTree FilePath
newTree = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    oldPath <- FilePath -> Shell FilePath
lstree FilePath
oldTree
    Just suffix <- return (Internal.stripPrefix (oldTree ++ "/") oldPath)
    let newPath = FilePath
newTree FilePath -> ShowS
</> FilePath
suffix
    isFile <- testfile oldPath
    if isFile
        then mktree (FilePath.takeDirectory newPath) >> cp oldPath newPath
        else mktree newPath )


-- | Remove a file
rm :: MonadIO io => FilePath -> io ()
rm :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
rm FilePath
path = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.removeFile FilePath
path)

-- | Remove a directory
rmdir :: MonadIO io => FilePath -> io ()
rmdir :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
rmdir FilePath
path = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ()
Directory.removeDirectory FilePath
path)

{-| Remove a directory tree (equivalent to @rm -r@)

    Use at your own risk
-}
rmtree :: MonadIO io => FilePath -> io ()
rmtree :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
rmtree FilePath
path0 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (FilePath -> Shell ()
loop FilePath
path0))
  where
    loop :: FilePath -> Shell ()
loop FilePath
path = do
        linkstat <- FilePath -> Shell FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
path
        let isLink = FileStatus -> Bool
PosixCompat.isSymbolicLink FileStatus
linkstat
            isDir = FileStatus -> Bool
PosixCompat.isDirectory FileStatus
linkstat
        if isLink
            then rm path
            else do
                if isDir
                    then (do
                        child <- ls path
                        loop child ) <|> rmdir path
                    else rm path

-- | Check if a file exists
testfile :: MonadIO io => FilePath -> io Bool
testfile :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path = IO Bool -> io Bool
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
Directory.doesFileExist FilePath
path)

-- | Check if a directory exists
testdir :: MonadIO io => FilePath -> io Bool
testdir :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
path = IO Bool -> io Bool
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
path)

-- | Check if a path exists
testpath :: MonadIO io => FilePath -> io Bool
testpath :: forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testpath FilePath
path = do
  exists <- FilePath -> io Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path
  if exists
    then return exists
    else testdir path

{-| Touch a file, updating the access and modification times to the current time

    Creates an empty file if it does not exist
-}
touch :: MonadIO io => FilePath -> io ()
touch :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
touch FilePath
file = do
    exists <- FilePath -> io Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
    liftIO (if 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 touchFile file
#endif
        else output file empty )

{-| This type is the same as @"System.Directory".`Directory.Permissions`@
    type except combining the `Directory.executable` and
    `Directory.searchable` fields into a single `executable` field for
    consistency with the Unix @chmod@.  This simplification is still entirely
    consistent with the behavior of "System.Directory", which treats the two
    fields as interchangeable.
-}
data Permissions = Permissions
    { Permissions -> Bool
_readable   :: Bool
    , Permissions -> Bool
_writable   :: Bool
    , Permissions -> Bool
_executable :: Bool
    } deriving (Permissions -> Permissions -> Bool
(Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool) -> Eq Permissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
/= :: Permissions -> Permissions -> Bool
Eq, ReadPrec [Permissions]
ReadPrec Permissions
Int -> ReadS Permissions
ReadS [Permissions]
(Int -> ReadS Permissions)
-> ReadS [Permissions]
-> ReadPrec Permissions
-> ReadPrec [Permissions]
-> Read Permissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Permissions
readsPrec :: Int -> ReadS Permissions
$creadList :: ReadS [Permissions]
readList :: ReadS [Permissions]
$creadPrec :: ReadPrec Permissions
readPrec :: ReadPrec Permissions
$creadListPrec :: ReadPrec [Permissions]
readListPrec :: ReadPrec [Permissions]
Read, Eq Permissions
Eq Permissions =>
(Permissions -> Permissions -> Ordering)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Permissions)
-> (Permissions -> Permissions -> Permissions)
-> Ord 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
$ccompare :: Permissions -> Permissions -> Ordering
compare :: Permissions -> Permissions -> Ordering
$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
>= :: Permissions -> Permissions -> Bool
$cmax :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
min :: Permissions -> Permissions -> Permissions
Ord, Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> FilePath
(Int -> Permissions -> ShowS)
-> (Permissions -> FilePath)
-> ([Permissions] -> ShowS)
-> Show Permissions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Permissions -> ShowS
showsPrec :: Int -> Permissions -> ShowS
$cshow :: Permissions -> FilePath
show :: Permissions -> FilePath
$cshowList :: [Permissions] -> ShowS
showList :: [Permissions] -> ShowS
Show)

{-| Under the hood, "System.Directory" does not distinguish between
    `Directory.executable` and `Directory.searchable`.  They both
    translate to the same `System.Posix.ownerExecuteMode` permission.  That
    means that we can always safely just set the `Directory.executable`
    field and safely leave the `Directory.searchable` field as `False`
    because the two fields are combined with (`||`) to determine whether to set
    the executable bit.
-}
toSystemDirectoryPermissions :: Permissions -> Directory.Permissions
toSystemDirectoryPermissions :: Permissions -> Permissions
toSystemDirectoryPermissions Permissions
p =
    ( Bool -> Permissions -> Permissions
Directory.setOwnerReadable   (Permissions -> Bool
_readable   Permissions
p)
    (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Permissions -> Permissions
Directory.setOwnerWritable   (Permissions -> Bool
_writable   Permissions
p)
    (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
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
    }

{-| Update a file or directory's user permissions

> chmod rwo         "foo.txt"  -- chmod u=rw foo.txt
> chmod executable  "foo.txt"  -- chmod u+x foo.txt
> chmod nonwritable "foo.txt"  -- chmod u-w foo.txt

    The meaning of each permission is:

    * `readable` (@+r@ for short): For files, determines whether you can read
      from that file (such as with `input`).  For directories, determines
      whether or not you can list the directory contents (such as with `ls`).
      Note: if a directory is not readable then `ls` will stream an empty list
      of contents

    * `writable` (@+w@ for short): For files, determines whether you can write
      to that file (such as with `output`).  For directories, determines whether
      you can create a new file underneath that directory.

    * `executable` (@+x@ for short): For files, determines whether or not that
      file is executable (such as with `proc`).  For directories, determines
      whether or not you can read or execute files underneath that directory
      (such as with `input` or `proc`)
-}
chmod
    :: MonadIO io
    => (Permissions -> Permissions)
    -- ^ Permissions update function
    -> FilePath
    -- ^ Path
    -> io Permissions
    -- ^ Updated permissions
chmod :: forall (io :: * -> *).
MonadIO io =>
(Permissions -> Permissions) -> FilePath -> io Permissions
chmod Permissions -> Permissions
modifyPermissions FilePath
path = IO Permissions -> io Permissions
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let path' :: FilePath
path' = ShowS
deslash FilePath
path
    permissions <- FilePath -> IO Permissions
Directory.getPermissions FilePath
path'
    let permissions' = Permissions -> Permissions
fromSystemDirectoryPermissions Permissions
permissions
    let permissions'' = Permissions -> Permissions
modifyPermissions Permissions
permissions'
        changed = Permissions
permissions' Permissions -> Permissions -> Bool
forall a. Eq a => a -> a -> Bool
/= Permissions
permissions''
    let permissions''' = Permissions -> Permissions
toSystemDirectoryPermissions Permissions
permissions''
    when changed (Directory.setPermissions path' permissions''')
    return permissions'' )

-- | Get a file or directory's user permissions
getmod :: MonadIO io => FilePath -> io Permissions
getmod :: forall (io :: * -> *). MonadIO io => FilePath -> io Permissions
getmod FilePath
path = IO Permissions -> io Permissions
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let path' :: FilePath
path' = ShowS
deslash FilePath
path
    permissions <- FilePath -> IO Permissions
Directory.getPermissions FilePath
path'
    return (fromSystemDirectoryPermissions permissions))

-- | Set a file or directory's user permissions
setmod :: MonadIO io => Permissions -> FilePath -> io ()
setmod :: forall (io :: * -> *).
MonadIO io =>
Permissions -> FilePath -> io ()
setmod Permissions
permissions FilePath
path = IO () -> io ()
forall a. IO a -> io a
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) )

-- | Copy a file or directory's permissions (analogous to @chmod --reference@)
copymod :: MonadIO io => FilePath -> FilePath -> io ()
copymod :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
copymod FilePath
sourcePath FilePath
targetPath = IO () -> io ()
forall a. IO a -> io a
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' )

-- | @+r@
readable :: Permissions -> Permissions
readable :: Permissions -> Permissions
readable Permissions
p = Permissions
p { _readable = True }

-- | @-r@
nonreadable :: Permissions -> Permissions
nonreadable :: Permissions -> Permissions
nonreadable Permissions
p = Permissions
p { _readable = False }

-- | @+w@
writable :: Permissions -> Permissions
writable :: Permissions -> Permissions
writable Permissions
p = Permissions
p { _writable = True }

-- | @-w@
nonwritable :: Permissions -> Permissions
nonwritable :: Permissions -> Permissions
nonwritable Permissions
p = Permissions
p { _writable = False }

-- | @+x@
executable :: Permissions -> Permissions
executable :: Permissions -> Permissions
executable Permissions
p = Permissions
p { _executable = True }

-- | @-x@
nonexecutable :: Permissions -> Permissions
nonexecutable :: Permissions -> Permissions
nonexecutable Permissions
p = Permissions
p { _executable = False }

-- | @-r -w -x@
ooo :: Permissions -> Permissions
ooo :: Permissions -> Permissions
ooo Permissions
_ = Permissions
    { _readable :: Bool
_readable   = Bool
False
    , _writable :: Bool
_writable   = Bool
False
    , _executable :: Bool
_executable = Bool
False
    }

-- | @+r -w -x@
roo :: Permissions -> Permissions
roo :: Permissions -> Permissions
roo = Permissions -> Permissions
readable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

-- | @-r +w -x@
owo :: Permissions -> Permissions
owo :: Permissions -> Permissions
owo = Permissions -> Permissions
writable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

-- | @-r -w +x@
oox :: Permissions -> Permissions
oox :: Permissions -> Permissions
oox = Permissions -> Permissions
executable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

-- | @+r +w -x@
rwo :: Permissions -> Permissions
rwo :: Permissions -> Permissions
rwo = Permissions -> Permissions
readable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
writable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

-- | @+r -w +x@
rox :: Permissions -> Permissions
rox :: Permissions -> Permissions
rox = Permissions -> Permissions
readable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
executable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

-- | @-r +w +x@
owx :: Permissions -> Permissions
owx :: Permissions -> Permissions
owx = Permissions -> Permissions
writable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
executable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

-- | @+r +w +x@
rwx :: Permissions -> Permissions
rwx :: Permissions -> Permissions
rwx = Permissions -> Permissions
readable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
writable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
executable (Permissions -> Permissions)
-> (Permissions -> Permissions) -> Permissions -> Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Permissions
ooo

{-| Time how long a command takes in monotonic wall clock time

    Returns the duration alongside the return value
-}
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 seconds1 nanoseconds1 <- IO TimeSpec -> io TimeSpec
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
    a <- io
    TimeSpec seconds2 nanoseconds2 <- liftIO (getTime Monotonic)
    let t = Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (    Int64
seconds2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-     Int64
seconds1)
          Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
nanoseconds2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
nanoseconds1) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
10Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9::Int)
    return (a, fromRational t)

-- | Get the system's host name
hostname :: MonadIO io => io Text
hostname :: forall (io :: * -> *). MonadIO io => io Text
hostname = IO Text -> io Text
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> Text) -> IO FilePath -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack IO FilePath
getHostName)

-- | Show the full path of an executable file
which :: MonadIO io => FilePath -> io (Maybe FilePath)
which :: forall (io :: * -> *).
MonadIO io =>
FilePath -> io (Maybe FilePath)
which FilePath
cmd = Shell FilePath
-> Fold FilePath (Maybe FilePath) -> io (Maybe FilePath)
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold (FilePath -> Shell FilePath
whichAll FilePath
cmd) Fold FilePath (Maybe FilePath)
forall a. Fold a (Maybe a)
Control.Foldl.head

-- | Show all matching executables in PATH, not just the first
whichAll :: FilePath -> Shell FilePath
whichAll :: FilePath -> Shell FilePath
whichAll FilePath
cmd = do
  Just paths <- Text -> Shell (Maybe Text)
forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
need Text
"PATH"
  path <- select (fmap Text.unpack (Text.splitOn ":" paths))
  let path' = FilePath
path FilePath -> ShowS
</> FilePath
cmd

  True <- testfile path'

  let handler :: IOError -> IO Bool
      handler IOError
e =
          if IOError -> Bool
isPermissionError IOError
e Bool -> Bool -> Bool
|| IOError -> Bool
isDoesNotExistError IOError
e
              then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              else IOError -> IO Bool
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO IOError
e

  let getIsExecutable = (Permissions -> Bool) -> IO Permissions -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Permissions -> Bool
_executable (FilePath -> IO Permissions
forall (io :: * -> *). MonadIO io => FilePath -> io Permissions
getmod FilePath
path')
  isExecutable <- liftIO (getIsExecutable `catchIOError` handler)

  guard isExecutable
  return path'

{-| Sleep for the given duration

    A numeric literal argument is interpreted as seconds.  In other words,
    @(sleep 2.0)@ will sleep for two seconds.
-}
sleep :: MonadIO io => NominalDiffTime -> io ()
sleep :: forall (io :: * -> *). MonadIO io => POSIXTime -> io ()
sleep POSIXTime
n = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay (POSIXTime -> Int
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime
n POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
10POSIXTime -> Int -> POSIXTime
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int))))

{-| Exit with the given exit code

    An exit code of @0@ indicates success
-}
exit :: MonadIO io => ExitCode -> io a
exit :: forall (io :: * -> *) a. MonadIO io => ExitCode -> io a
exit ExitCode
code = IO a -> io a
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
code)

-- | Throw an exception using the provided `Text` message
die :: MonadIO io => Text -> io a
die :: forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
txt = IO a -> io a
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (FilePath -> IOError
userError (Text -> FilePath
unpack Text
txt)))

infixr 2 .||.
infixr 3 .&&.

{-| Analogous to `&&` in Bash

    Runs the second command only if the first one returns `ExitSuccess`
-}
(.&&.) :: 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
    r <- m ExitCode
cmd1
    case r of
        ExitCode
ExitSuccess -> m ExitCode
cmd2
        ExitCode
_           -> ExitCode -> m ExitCode
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
r

{-| Analogous to `||` in Bash

    Run the second command only if the first one returns `ExitFailure`
-}
(.||.) :: 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
    r <- m ExitCode
cmd1
    case r of
        ExitFailure Int
_ -> m ExitCode
cmd2
        ExitCode
_             -> ExitCode -> m ExitCode
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
r

{-| Create a temporary directory underneath the given directory

    Deletes the temporary directory when done
-}
mktempdir
    :: MonadManaged managed
    => FilePath
    -- ^ Parent directory
    -> Text
    -- ^ Directory name template
    -> managed FilePath
mktempdir :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed FilePath
mktempdir FilePath
parent Text
prefix = Managed FilePath -> managed FilePath
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
    let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
    (forall r. (FilePath -> IO r) -> IO r) -> Managed FilePath
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (FilePath -> FilePath -> (FilePath -> IO r) -> IO r
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTempDirectory FilePath
parent FilePath
prefix'))

{-| Create a temporary file underneath the given directory

    Deletes the temporary file when done

    Note that this provides the `Handle` of the file in order to avoid a
    potential race condition from the file being moved or deleted before you
    have a chance to open the file.  The `mktempfile` function provides a
    simpler API if you don't need to worry about that possibility.
-}
mktemp
    :: MonadManaged managed
    => FilePath
    -- ^ Parent directory
    -> Text
    -- ^ File name template
    -> managed (FilePath, Handle)
mktemp :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed (FilePath, Handle)
mktemp FilePath
parent Text
prefix = Managed (FilePath, Handle) -> managed (FilePath, Handle)
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
    let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
    (file', handle) <- (forall r. ((FilePath, Handle) -> IO r) -> IO r)
-> Managed (FilePath, Handle)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\(FilePath, Handle) -> IO r
k ->
        FilePath -> FilePath -> (FilePath -> Handle -> IO r) -> IO r
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)) )
    return (file', handle) )

{-| Create a temporary file underneath the given directory

    Deletes the temporary file when done
-}
mktempfile
    :: MonadManaged managed
    => FilePath
    -- ^ Parent directory
    -> Text
    -- ^ File name template
    -> managed FilePath
mktempfile :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed FilePath
mktempfile FilePath
parent Text
prefix = Managed FilePath -> managed FilePath
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
    let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
    (file', handle) <- (forall r. ((FilePath, Handle) -> IO r) -> IO r)
-> Managed (FilePath, Handle)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\(FilePath, Handle) -> IO r
k ->
        FilePath -> FilePath -> (FilePath -> Handle -> IO r) -> IO r
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)) )
    liftIO (hClose handle)
    return file' )

-- | Fork a thread, acquiring an `Async` value
fork :: MonadManaged managed => IO a -> managed (Async a)
fork :: forall (managed :: * -> *) a.
MonadManaged managed =>
IO a -> managed (Async a)
fork IO a
io = Managed (Async a) -> managed (Async a)
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. (Async a -> IO r) -> IO r) -> Managed (Async a)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (IO a -> (Async a -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync IO a
io))

-- | Wait for an `Async` action to complete
wait :: MonadIO io => Async a -> io a
wait :: forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async a
a = IO a -> io a
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Async a -> IO a
forall a. Async a -> IO a
Control.Concurrent.Async.wait Async a
a)

-- | Read lines of `Text` from standard input
stdin :: Shell Line
stdin :: Shell Line
stdin = Handle -> Shell Line
inhandle Handle
IO.stdin

-- | Read lines of `Text` from a file
input :: FilePath -> Shell Line
input :: FilePath -> Shell Line
input FilePath
file = do
    handle <- Managed Handle -> Shell Handle
forall a. Managed a -> Shell a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
readonly FilePath
file)
    inhandle handle

-- | Read lines of `Text` from a `Handle`
inhandle :: Handle -> Shell Line
inhandle :: Handle -> Shell Line
inhandle Handle
handle = (forall r. FoldShell Line r -> IO r) -> Shell Line
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
            eof <- Handle -> IO Bool
IO.hIsEOF Handle
handle
            if eof
                then done x
                else do
                    txt <- Text.hGetLine handle
                    x'  <- step x (unsafeTextToLine txt)
                    loop $! x'
    x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
begin )

-- | Stream lines of `Text` to standard output
stdout :: MonadIO io => Shell Line -> io ()
stdout :: forall (io :: * -> *). MonadIO io => Shell Line -> io ()
stdout Shell Line
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    line <- Shell Line
s
    liftIO (echo line) )

-- | Stream lines of `Text` to a file
output :: MonadIO io => FilePath -> Shell Line -> io ()
output :: forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
output FilePath
file Shell Line
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    handle <- Managed Handle -> Shell Handle
forall a. Managed a -> Shell a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
writeonly FilePath
file)
    line   <- s
    liftIO (Text.hPutStrLn handle (lineToText line)) )

-- | Stream lines of `Text` to a `Handle`
outhandle :: MonadIO io => Handle -> Shell Line -> io ()
outhandle :: forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
handle Shell Line
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    line <- Shell Line
s
    liftIO (Text.hPutStrLn handle (lineToText line)) )

-- | Stream lines of `Text` to append to a file
append :: MonadIO io => FilePath -> Shell Line -> io ()
append :: forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
append FilePath
file Shell Line
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    handle <- Managed Handle -> Shell Handle
forall a. Managed a -> Shell a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
appendonly FilePath
file)
    line   <- s
    liftIO (Text.hPutStrLn handle (lineToText line)) )

-- | Stream lines of `Text` to standard error
stderr :: MonadIO io => Shell Line -> io ()
stderr :: forall (io :: * -> *). MonadIO io => Shell Line -> io ()
stderr Shell Line
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    line <- Shell Line
s
    liftIO (err line) )

-- | Read in a stream's contents strictly
strict :: MonadIO io => Shell Line -> io Text
strict :: forall (io :: * -> *). MonadIO io => Shell Line -> io Text
strict Shell Line
s = ([Line] -> Text) -> io [Line] -> io Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Line] -> Text
linesToText (Shell Line -> Fold Line [Line] -> io [Line]
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell Line
s Fold Line [Line]
forall a. Fold a [a]
list)

-- | Acquire a `Managed` read-only `Handle` from a `FilePath`
readonly :: MonadManaged managed => FilePath -> managed Handle
readonly :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
readonly FilePath
file = Managed Handle -> managed Handle
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. (Handle -> IO r) -> IO r) -> Managed Handle
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
file IOMode
IO.ReadMode))

-- | Acquire a `Managed` write-only `Handle` from a `FilePath`
writeonly :: MonadManaged managed => FilePath -> managed Handle
writeonly :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
writeonly FilePath
file = Managed Handle -> managed Handle
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. (Handle -> IO r) -> IO r) -> Managed Handle
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
file IOMode
IO.WriteMode))

-- | Acquire a `Managed` append-only `Handle` from a `FilePath`
appendonly :: MonadManaged managed => FilePath -> managed Handle
appendonly :: forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
appendonly FilePath
file = Managed Handle -> managed Handle
forall a. Managed a -> managed a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. (Handle -> IO r) -> IO r) -> Managed Handle
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile FilePath
file IOMode
IO.AppendMode))

-- | Combine the output of multiple `Shell`s, in order
cat :: [Shell a] -> Shell a
cat :: forall a. [Shell a] -> Shell a
cat = [Shell a] -> Shell a
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' = (b -> Bool) -> Shell b -> Shell b
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not (Bool -> Bool) -> (b -> Bool) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> (b -> [a]) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Text -> [a]
forall a. Pattern a -> Text -> [a]
match Pattern a
pattern' (Text -> [a]) -> (b -> Text) -> b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Text
f)

-- | Keep all lines that match the given `Pattern`
grep :: Pattern a -> Shell Line -> Shell Line
grep :: forall a. Pattern a -> Shell Line -> Shell Line
grep = (Line -> Text) -> Pattern a -> Shell Line -> Shell Line
forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith Line -> Text
lineToText

-- | Keep every `Text` element that matches the given `Pattern`
grepText :: Pattern a -> Shell Text -> Shell Text
grepText :: forall a. Pattern a -> Shell Text -> Shell Text
grepText = (Text -> Text) -> Pattern a -> Shell Text -> Shell Text
forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith Text -> Text
forall a. a -> a
id

{-| Replace all occurrences of a `Pattern` with its `Text` result

    `sed` performs substitution on a line-by-line basis, meaning that
    substitutions may not span multiple lines.  Additionally, substitutions may
    occur multiple times within the same line, like the behavior of
    @s\/...\/...\/g@.

    Warning: Do not use a `Pattern` that matches the empty string, since it will
    match an infinite number of times.  `sed` tries to detect such `Pattern`s
    and `die` with an error message if they occur, but this detection is
    necessarily incomplete.
-}
sed :: Pattern Text -> Shell Line -> Shell Line
sed :: Pattern Text -> Shell Line -> Shell Line
sed Pattern Text
pattern' Shell Line
s = do
    Bool -> Shell () -> Shell ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Pattern Text -> Bool
forall {a}. Pattern a -> Bool
matchesEmpty Pattern Text
pattern') (Text -> Shell ()
forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
message)
    let pattern'' :: Pattern Text
pattern'' = ([Text] -> Text) -> Pattern [Text] -> Pattern Text
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat
            (Pattern Text -> Pattern [Text]
forall a. Pattern a -> Pattern [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Pattern Text
pattern' Pattern Text -> Pattern Text -> Pattern Text
forall a. Pattern a -> Pattern a -> Pattern a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Text) -> Pattern Char -> Pattern Text
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton Pattern Char
anyChar))
    line   <- Shell Line
s
    txt':_ <- return (match pattern'' (lineToText line))
    select (textToLines txt')
  where
    message :: Text
message = Text
"sed: the given pattern matches the empty string"
    matchesEmpty :: Pattern a -> Bool
matchesEmpty = Bool -> Bool
not (Bool -> Bool) -> (Pattern a -> Bool) -> Pattern a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> (Pattern a -> [a]) -> Pattern a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern a -> Text -> [a]) -> Text -> Pattern a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern a -> Text -> [a]
forall a. Pattern a -> Text -> [a]
match Text
""

{-| Like `sed`, but the provided substitution must match the beginning of the
    line
-}
sedPrefix :: Pattern Text -> Shell Line -> Shell Line
sedPrefix :: Pattern Text -> Shell Line -> Shell Line
sedPrefix Pattern Text
pattern' Shell Line
s = do
    line   <- Shell Line
s
    txt':_ <- return (match ((pattern' <> chars) <|> chars) (lineToText line))
    select (textToLines txt')

-- | Like `sed`, but the provided substitution must match the end of the line
sedSuffix :: Pattern Text -> Shell Line -> Shell Line
sedSuffix :: Pattern Text -> Shell Line -> Shell Line
sedSuffix Pattern Text
pattern' Shell Line
s = do
    line   <- Shell Line
s
    txt':_ <- return (match ((chars <> pattern') <|> chars) (lineToText line))
    select (textToLines txt')

-- | Like `sed`, but the provided substitution must match the entire line
sedEntire :: Pattern Text -> Shell Line -> Shell Line
sedEntire :: Pattern Text -> Shell Line -> Shell Line
sedEntire Pattern Text
pattern' Shell Line
s = do
    line   <- Shell Line
s
    txt':_ <- return (match (pattern' <|> chars)(lineToText line))
    select (textToLines txt')

-- | Make a `Shell Text -> Shell Text` function work on `FilePath`s instead.
-- | Ignores any paths which cannot be decoded as valid `Text`.
onFiles :: (Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath
onFiles :: (Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath
onFiles Shell Text -> Shell Text
f = (Text -> FilePath) -> Shell Text -> Shell FilePath
forall a b. (a -> b) -> Shell a -> Shell b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack (Shell Text -> Shell FilePath)
-> (Shell FilePath -> Shell Text)
-> Shell FilePath
-> Shell FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shell Text -> Shell Text
f (Shell Text -> Shell Text)
-> (Shell FilePath -> Shell Text) -> Shell FilePath -> Shell Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Text) -> Shell FilePath -> Shell Text
forall a b. (a -> b) -> Shell a -> Shell b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack

-- | Like `sed`, but operates in place on a `FilePath` (analogous to @sed -i@)
inplace :: MonadIO io => Pattern Text -> FilePath -> io ()
inplace :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplace = (Shell Line -> Shell Line) -> FilePath -> io ()
forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update ((Shell Line -> Shell Line) -> FilePath -> io ())
-> (Pattern Text -> Shell Line -> Shell Line)
-> Pattern Text
-> FilePath
-> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sed

-- | Like `sedPrefix`, but operates in place on a `FilePath`
inplacePrefix :: MonadIO io => Pattern Text -> FilePath -> io ()
inplacePrefix :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplacePrefix = (Shell Line -> Shell Line) -> FilePath -> io ()
forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update ((Shell Line -> Shell Line) -> FilePath -> io ())
-> (Pattern Text -> Shell Line -> Shell Line)
-> Pattern Text
-> FilePath
-> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sedPrefix

-- | Like `sedSuffix`, but operates in place on a `FilePath`
inplaceSuffix :: MonadIO io => Pattern Text -> FilePath -> io ()
inplaceSuffix :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplaceSuffix = (Shell Line -> Shell Line) -> FilePath -> io ()
forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update ((Shell Line -> Shell Line) -> FilePath -> io ())
-> (Pattern Text -> Shell Line -> Shell Line)
-> Pattern Text
-> FilePath
-> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sedSuffix

-- | Like `sedEntire`, but operates in place on a `FilePath`
inplaceEntire :: MonadIO io => Pattern Text -> FilePath -> io ()
inplaceEntire :: forall (io :: * -> *).
MonadIO io =>
Pattern Text -> FilePath -> io ()
inplaceEntire = (Shell Line -> Shell Line) -> FilePath -> io ()
forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update ((Shell Line -> Shell Line) -> FilePath -> io ())
-> (Pattern Text -> Shell Line -> Shell Line)
-> Pattern Text
-> FilePath
-> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Text -> Shell Line -> Shell Line
sedEntire

{-| Update a file in place using a `Shell` transformation

    For example, this is used to implement the @inplace*@ family of utilities
-}
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Managed () -> IO ()
runManaged (do
    here <- Managed FilePath
forall (io :: * -> *). MonadIO io => io FilePath
pwd

    (tmpfile, handle) <- mktemp here "turtle"

    outhandle handle (f (input file))

    liftIO (hClose handle)

    copymod file tmpfile

    mv tmpfile file ))

-- | Search a directory recursively for all files matching the given `Pattern`
find :: Pattern a -> FilePath -> Shell FilePath
find :: forall a. Pattern a -> FilePath -> Shell FilePath
find Pattern a
pattern' FilePath
dir = do
    path <- (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
isNotSymlink FilePath
dir

    let txt = FilePath -> Text
Text.pack FilePath
path

    _:_ <- return (match pattern' txt)

    return path
  where
    isNotSymlink :: FilePath -> IO Bool
    isNotSymlink :: FilePath -> IO Bool
isNotSymlink FilePath
file = do
      file_stat <- FilePath -> IO FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
      return (not (PosixCompat.isSymbolicLink file_stat))

-- | Filter a shell of FilePaths according to a given pattern
findtree :: Pattern a -> Shell FilePath -> Shell FilePath
findtree :: forall a. Pattern a -> Shell FilePath -> Shell FilePath
findtree Pattern a
pat Shell FilePath
files = do
  path <- Shell FilePath
files

  let txt = FilePath -> Text
Text.pack FilePath
path

  _:_ <- return (match pat txt)

  return path

{- | Check if a file was last modified after a given
     timestamp
-}     
cmin :: MonadIO io => UTCTime -> FilePath -> io Bool
cmin :: forall (io :: * -> *). MonadIO io => UTCTime -> FilePath -> io Bool
cmin UTCTime
t FilePath
file = do
  status <- FilePath -> io FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
  return (adapt status)
  where
    adapt :: FileStatus -> Bool
adapt FileStatus
x = POSIXTime -> UTCTime
posixSecondsToUTCTime (FileStatus -> POSIXTime
modificationTime FileStatus
x) UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
t

{- | Check if a file was last modified before a given
     timestamp
-}     
cmax :: MonadIO io => UTCTime -> FilePath -> io Bool
cmax :: forall (io :: * -> *). MonadIO io => UTCTime -> FilePath -> io Bool
cmax UTCTime
t FilePath
file = do
  status <- FilePath -> io FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
  return (adapt status)
  where
    adapt :: FileStatus -> Bool
adapt FileStatus
x = POSIXTime -> UTCTime
posixSecondsToUTCTime (FileStatus -> POSIXTime
modificationTime FileStatus
x) UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
t
  
-- | A Stream of @\"y\"@s
yes :: Shell Line
yes :: Shell Line
yes = (() -> Line) -> Shell () -> Shell Line
forall a b. (a -> b) -> Shell a -> Shell b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\()
_ -> Line
"y") Shell ()
endless

-- | Number each element of a `Shell` (starting at 0)
nl :: Num n => Shell a -> Shell (n, a)
nl :: forall n a. Num n => Shell a -> Shell (n, a)
nl Shell a
s = (forall r. FoldShell (n, a) r -> IO r) -> Shell (n, a)
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell FoldShell (n, a) r -> IO r
forall r. FoldShell (n, a) r -> IO r
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) = Shell a -> forall r. FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s (((x, b) -> a -> IO (x, b))
-> (x, b) -> ((x, b) -> IO b) -> FoldShell a b
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' (x, b) -> IO b
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 -> (b, a) -> IO x
step x
x (b
n, a
a)
            let n' = b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
            n' `seq` return (x', 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

{-| Merge two `Shell`s together, element-wise

    If one `Shell` is longer than the other, the excess elements are
    truncated
-}
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 r. FoldShell (a, b) r -> IO r) -> Shell (a, b)
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell FoldShell (a, b) r -> IO r
forall r. FoldShell (a, b) r -> IO r
_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 <- STM (TVar (ZipState a b)) -> IO (TVar (ZipState a b))
forall a. STM a -> IO a
STM.atomically (ZipState a b -> STM (TVar (ZipState a b))
forall a. a -> STM (TVar a)
STM.newTVar ZipState a b
forall a b. ZipState a b
Empty)

        let begin = ()

        let stepA () a
a = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (do
                x <- TVar (ZipState a b) -> STM (ZipState a b)
forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
                case x of
                    ZipState a b
Empty -> TVar (ZipState a b) -> ZipState a b -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar (a -> ZipState a b
forall a b. a -> ZipState a b
HasA a
a)
                    ZipState a b
Done  -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    ZipState a b
_     -> STM ()
forall a. STM a
STM.retry )
        let doneA () = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (do
                x <- TVar (ZipState a b) -> STM (ZipState a b)
forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
                case x of
                    ZipState a b
Empty -> TVar (ZipState a b) -> ZipState a b -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar ZipState a b
forall a b. ZipState a b
Done
                    ZipState a b
Done  -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    ZipState a b
_     -> STM ()
forall a. STM a
STM.retry )
        let foldA = (() -> a -> IO ()) -> () -> (() -> IO ()) -> FoldShell a ()
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
b = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (do
                x <- TVar (ZipState a b) -> STM (ZipState a b)
forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
                case x of
                    HasA a
a -> TVar (ZipState a b) -> ZipState a b -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar (a -> b -> ZipState a b
forall a b. a -> b -> ZipState a b
HasAB a
a b
b)
                    ZipState a b
Done   -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    ZipState a b
_      -> STM ()
forall a. STM a
STM.retry )
        let doneB () = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (do
                x <- TVar (ZipState a b) -> STM (ZipState a b)
forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
                case x of
                    HasA a
_ -> TVar (ZipState a b) -> ZipState a b -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar ZipState a b
forall a b. ZipState a b
Done
                    ZipState a b
Done   -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    ZipState a b
_      -> STM ()
forall a. STM a
STM.retry )
        let foldB = (() -> b -> IO ()) -> () -> (() -> IO ()) -> FoldShell b ()
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell () -> b -> IO ()
stepB ()
begin () -> IO ()
doneB

        withAsync (_foldShell sA foldA) (\Async ()
asyncA -> do
            IO () -> (Async () -> IO b) -> IO b
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (Shell b -> forall r. FoldShell b r -> IO r
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
                        y <- STM (Maybe (a, b)) -> IO (Maybe (a, b))
forall a. STM a -> IO a
STM.atomically (do
                            z <- TVar (ZipState a b) -> STM (ZipState a b)
forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
                            case z of
                                HasAB a
a b
b -> do
                                    TVar (ZipState a b) -> ZipState a b -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (ZipState a b)
tvar ZipState a b
forall a b. ZipState a b
Empty
                                    Maybe (a, b) -> STM (Maybe (a, b))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
b))
                                ZipState a b
Done      -> Maybe (a, b) -> STM (Maybe (a, b))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return  Maybe (a, b)
forall a. Maybe a
Nothing
                                ZipState a b
_         -> STM (Maybe (a, b))
forall a. STM a
STM.retry )
                        case y of
                            Maybe (a, b)
Nothing -> x -> IO x
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
                            Just (a, b)
ab -> do
                                x' <- x -> (a, b) -> IO x
stepAB x
x (a, b)
ab
                                loop $! x'
                x' <- x -> IO x
loop (x -> IO x) -> x -> IO x
forall a b. (a -> b) -> a -> b
$! x
beginAB
                wait asyncA
                wait asyncB
                doneAB x' ) )

-- | A `Shell` that endlessly emits @()@
endless :: Shell ()
endless :: Shell ()
endless = (forall r. FoldShell () r -> IO r) -> Shell ()
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 -> () -> IO x
step x
x ()
            loop $! x'
    x -> IO r
forall {b}. x -> IO b
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
begin )

{-| Limit a `Shell` to a fixed number of values

    NOTE: This is not lazy and will still consume the entire input stream.
    There is no way to implement a lazy version of this utility.
-}
limit :: Int -> Shell a -> Shell a
limit :: forall a. Int -> Shell a -> Shell a
limit Int
n Shell a
s = (forall r. FoldShell a r -> IO r) -> Shell a
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
    ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0  -- I feel so dirty
    let step' x
x a
a = do
            n' <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
ref
            writeIORef ref (n' + 1)
            if n' < n then step x a else return x
    _foldShell s (FoldShell step' begin done) )

{-| Limit a `Shell` to values that satisfy the predicate

    This terminates the stream on the first value that does not satisfy the
    predicate
-}
limitWhile :: (a -> Bool) -> Shell a -> Shell a
limitWhile :: forall a. (a -> Bool) -> Shell a -> Shell a
limitWhile a -> Bool
predicate Shell a
s = (forall r. FoldShell a r -> IO r) -> Shell a
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
    ref <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
    let step' x
x a
a = do
            b <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ref
            let b' = Bool
b Bool -> Bool -> Bool
&& a -> Bool
predicate a
a
            writeIORef ref b'
            if b' then step x a else return x
    _foldShell s (FoldShell step' begin done) )

{-| Cache a `Shell`'s output so that repeated runs of the script will reuse the
    result of previous runs.  You must supply a `FilePath` where the cached
    result will be stored.

    The stored result is only reused if the `Shell` successfully ran to
    completion without any exceptions.  Note: on some platforms Ctrl-C will
    flush standard input and signal end of file before killing the program,
    which may trick the program into \"successfully\" completing.
-}
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 <- FilePath -> Shell Line
input FilePath
file
            case reads (Text.unpack (lineToText line)) of
                [(Maybe a
ma, FilePath
"")] -> Maybe a -> Shell (Maybe a)
forall a. a -> Shell a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
ma
                [(Maybe a, FilePath)]
_          ->
                    Text -> Shell (Maybe a)
forall (io :: * -> *) a. MonadIO io => Text -> io a
die (Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
format (Format (FilePath -> Text) (FilePath -> Text)
"cache: Invalid data stored in "Format (FilePath -> Text) (FilePath -> Text)
-> Format Text (FilePath -> Text) -> Format Text (FilePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (FilePath -> Text)
forall a r. Show a => Format r (a -> r)
w) FilePath
file)
    exists <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
    mas    <- fold (if exists then cached else empty) list
    case [ () | Nothing <- mas ] of
        ()
_:[()]
_ -> [a] -> Shell a
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select [ a
a | Just a
a <- [Maybe a]
mas ]
        [()]
_   -> do
            handle <- Managed Handle -> Shell Handle
forall a. Managed a -> Shell a
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
writeonly FilePath
file)
            let justs = do
                    a      <- Shell a
s
                    liftIO (Text.hPutStrLn handle (Text.pack (show (Just a))))
                    return a
            let nothing = do
                    let n :: Maybe ()
n = Maybe ()
forall a. Maybe a
Nothing :: Maybe ()
                    IO () -> Shell ()
forall a. IO a -> Shell a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (FilePath -> Text
Text.pack (Maybe () -> FilePath
forall a. Show a => a -> FilePath
show Maybe ()
n)))
                    Shell b
forall a. Shell a
forall (f :: * -> *) a. Alternative f => f a
empty
            justs <|> nothing

{-| Run a list of IO actions in parallel using fork and wait.


>>> view (parallel [(sleep 3) >> date, date, date])
2016-12-01 17:22:10.83296 UTC
2016-12-01 17:22:07.829876 UTC
2016-12-01 17:22:07.829963 UTC

-}
parallel :: [IO a] -> Shell a
parallel :: forall a. [IO a] -> Shell a
parallel = (IO a -> Shell (Async a)) -> [IO a] -> Shell [Async a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse IO a -> Shell (Async a)
forall (managed :: * -> *) a.
MonadManaged managed =>
IO a -> managed (Async a)
fork ([IO a] -> Shell [Async a])
-> ([Async a] -> Shell a) -> [IO a] -> Shell a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Async a] -> Shell (Async a)
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select ([Async a] -> Shell (Async a))
-> (Async a -> Shell a) -> [Async a] -> Shell a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Async a -> Shell a
forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait

-- | Split a line into chunks delimited by the given `Pattern`
cut :: Pattern a -> Text -> [Text]
cut :: forall a. Pattern a -> Text -> [Text]
cut Pattern a
pattern' Text
txt = [[Text]] -> [Text]
forall a. HasCallStack => [a] -> a
head (Pattern [Text] -> Text -> [[Text]]
forall a. Pattern a -> Text -> [a]
match (Pattern Text -> Pattern Text
forall a. Pattern a -> Pattern a
selfless Pattern Text
chars Pattern Text -> Pattern a -> Pattern [Text]
forall a b. Pattern a -> Pattern b -> Pattern [a]
`sepBy` Pattern a
pattern') Text
txt)
-- This `head` should be safe ... in theory

-- | Get the current time
date :: MonadIO io => io UTCTime
date :: forall (io :: * -> *). MonadIO io => io UTCTime
date = IO UTCTime -> io UTCTime
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime

-- | Get the time a file was last modified
datefile :: MonadIO io => FilePath -> io UTCTime
datefile :: forall (io :: * -> *). MonadIO io => FilePath -> io UTCTime
datefile FilePath
path = IO UTCTime -> io UTCTime
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO UTCTime
Directory.getModificationTime FilePath
path)

-- | Get the size of a file or a directory
du :: MonadIO io => FilePath -> io Size
du :: forall (io :: * -> *). MonadIO io => FilePath -> io Size
du FilePath
path = IO Size -> io Size
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    isDir <- FilePath -> IO Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
path
    size <- do
        if isDir
        then do
            let sizes = do
                    child <- FilePath -> Shell FilePath
lstree FilePath
path
                    True  <- testfile child
                    liftIO (Directory.getFileSize child)
            fold sizes Control.Foldl.sum
        else Directory.getFileSize path
    return (Size size) )

{-| An abstract file size

    Specify the units you want by using an accessor like `kilobytes`

    The `Num` instance for `Size` interprets numeric literals as bytes
-}
newtype Size = Size { Size -> Integer
_bytes :: Integer } deriving (Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Eq Size
Eq Size =>
(Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord 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
$ccompare :: Size -> Size -> Ordering
compare :: Size -> Size -> Ordering
$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
>= :: Size -> Size -> Bool
$cmax :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
min :: Size -> Size -> Size
Ord, Integer -> Size
Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Integer -> Size)
-> Num Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c- :: Size -> Size -> Size
- :: Size -> Size -> Size
$c* :: Size -> Size -> Size
* :: Size -> Size -> Size
$cnegate :: Size -> Size
negate :: Size -> Size
$cabs :: Size -> Size
abs :: Size -> Size
$csignum :: Size -> Size
signum :: Size -> Size
$cfromInteger :: Integer -> Size
fromInteger :: Integer -> Size
Num)

instance Show Size where
    show :: Size -> FilePath
show = Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer -> FilePath) -> (Size -> Integer) -> Size -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Integer
_bytes

{-| `Format` a `Size` using a human readable representation

>>> format sz 42
"42 B"
>>> format sz 2309
"2.309 KB"
>>> format sz 949203
"949.203 KB"
>>> format sz 1600000000
"1.600 GB"
>>> format sz 999999999999999999
"999999.999 TB"
-}
sz :: Format r (Size -> r)
sz :: forall r. Format r (Size -> r)
sz = (Size -> Text) -> Format r (Size -> r)
forall a r. (a -> Text) -> Format r (a -> r)
makeFormat (\(Size Integer
numBytes) ->
    let (Integer
numKilobytes, Integer
remainingBytes    ) = Integer
numBytes     Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
        (Integer
numMegabytes, Integer
remainingKilobytes) = Integer
numKilobytes Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
        (Integer
numGigabytes, Integer
remainingMegabytes) = Integer
numMegabytes Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
        (Integer
numTerabytes, Integer
remainingGigabytes) = Integer
numGigabytes Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000
    in  if Integer
numKilobytes Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
        then Format Text (Integer -> Text) -> Integer -> Text
forall r. Format Text r -> r
format (Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat Text (Integer -> Text)
-> Format Text Text -> Format Text (Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" B" ) Integer
remainingBytes
        else if Integer
numMegabytes Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        then Format Text (Integer -> Integer -> Text)
-> Integer -> Integer -> Text
forall r. Format Text r -> r
format (Format (Integer -> Text) (Integer -> Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat (Integer -> Text) (Integer -> Integer -> Text)
-> Format (Integer -> Text) (Integer -> Text)
-> Format (Integer -> Text) (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."Format (Integer -> Text) (Integer -> Integer -> Text)
-> Format Text (Integer -> Text)
-> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat Text (Integer -> Integer -> Text)
-> Format Text Text -> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" KB") Integer
remainingKilobytes Integer
remainingBytes
        else if Integer
numGigabytes Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        then Format Text (Integer -> Integer -> Text)
-> Integer -> Integer -> Text
forall r. Format Text r -> r
format (Format (Integer -> Text) (Integer -> Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat (Integer -> Text) (Integer -> Integer -> Text)
-> Format (Integer -> Text) (Integer -> Text)
-> Format (Integer -> Text) (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."Format (Integer -> Text) (Integer -> Integer -> Text)
-> Format Text (Integer -> Text)
-> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat Text (Integer -> Integer -> Text)
-> Format Text Text -> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" MB") Integer
remainingMegabytes Integer
remainingKilobytes
        else if Integer
numTerabytes Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        then Format Text (Integer -> Integer -> Text)
-> Integer -> Integer -> Text
forall r. Format Text r -> r
format (Format (Integer -> Text) (Integer -> Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat (Integer -> Text) (Integer -> Integer -> Text)
-> Format (Integer -> Text) (Integer -> Text)
-> Format (Integer -> Text) (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."Format (Integer -> Text) (Integer -> Integer -> Text)
-> Format Text (Integer -> Text)
-> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat Text (Integer -> Integer -> Text)
-> Format Text Text -> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" GB") Integer
remainingGigabytes Integer
remainingMegabytes
        else Format Text (Integer -> Integer -> Text)
-> Integer -> Integer -> Text
forall r. Format Text r -> r
format (Format (Integer -> Text) (Integer -> Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat (Integer -> Text) (Integer -> Integer -> Text)
-> Format (Integer -> Text) (Integer -> Text)
-> Format (Integer -> Text) (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Integer -> Text) (Integer -> Text)
"."Format (Integer -> Text) (Integer -> Integer -> Text)
-> Format Text (Integer -> Text)
-> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat Text (Integer -> Integer -> Text)
-> Format Text Text -> Format Text (Integer -> Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" TB") Integer
numTerabytes       Integer
remainingGigabytes )

{-| Construct a 'Size' from an integer in bytes

>>> format sz (B 42)
"42 B"
-}
pattern B :: Integral n => n -> Size
pattern $mB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bB :: forall n. Integral n => n -> Size
B { forall n. Integral n => Size -> n
bytes } <- (fromInteger . _bytes -> bytes)
  where
    B = n -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# COMPLETE B #-}

{-| Construct a 'Size' from an integer in kilobytes

>>> format sz (KB 42)
"42.0 KB"
>>> let B n = KB 1 in n
1000
-}
pattern KB :: Integral n => n -> Size
pattern $mKB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bKB :: forall n. Integral n => n -> Size
KB { forall n. Integral n => Size -> n
kilobytes } <- (\(B n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1000 -> kilobytes)
  where
    KB = n -> Size
forall n. Integral n => n -> Size
B (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE KB #-}

{-| Construct a 'Size' from an integer in megabytes

>>> format sz (MB 42)
"42.0 MB"
>>> let KB n = MB 1 in n
1000
-}
pattern MB :: Integral n => n -> Size
pattern $mMB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bMB :: forall n. Integral n => n -> Size
MB { forall n. Integral n => Size -> n
megabytes } <- (\(KB n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1000 -> megabytes)
  where
    MB = n -> Size
forall n. Integral n => n -> Size
KB (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE MB #-}

{-| Construct a 'Size' from an integer in gigabytes

>>> format sz (GB 42)
"42.0 GB"
>>> let MB n = GB 1 in n
1000
-}
pattern GB :: Integral n => n -> Size
pattern $mGB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bGB :: forall n. Integral n => n -> Size
GB { forall n. Integral n => Size -> n
gigabytes } <- (\(MB n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1000 -> gigabytes)
  where
    GB = n -> Size
forall n. Integral n => n -> Size
MB (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE GB #-}

{-| Construct a 'Size' from an integer in terabytes

>>> format sz (TB 42)
"42.0 TB"
>>> let GB n = TB 1 in n
1000
-}
pattern TB :: Integral n => n -> Size
pattern $mTB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bTB :: forall n. Integral n => n -> Size
TB { forall n. Integral n => Size -> n
terabytes } <- (\(GB n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1000 -> terabytes)
  where
    TB = n -> Size
forall n. Integral n => n -> Size
GB (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE TB #-}

{-| Construct a 'Size' from an integer in kibibytes

>>> format sz (KiB 42)
"43.8 KB"
>>> let B n = KiB 1 in n
1024
-}
pattern KiB :: Integral n => n -> Size
pattern $mKiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bKiB :: forall n. Integral n => n -> Size
KiB { forall n. Integral n => Size -> n
kibibytes } <- (\(B n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1024 -> kibibytes)
  where
    KiB = n -> Size
forall n. Integral n => n -> Size
B (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE KiB #-}

{-| Construct a 'Size' from an integer in mebibytes

>>> format sz (MiB 42)
"44.40 MB"
>>> let KiB n = MiB 1 in n
1024
-}
pattern MiB :: Integral n => n -> Size
pattern $mMiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bMiB :: forall n. Integral n => n -> Size
MiB { forall n. Integral n => Size -> n
mebibytes } <- (\(KiB n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1024 -> mebibytes)
  where
    MiB = n -> Size
forall n. Integral n => n -> Size
KiB (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE MiB #-}

{-| Construct a 'Size' from an integer in gibibytes

>>> format sz (GiB 42)
"45.97 GB"
>>> let MiB n = GiB 1 in n
1024
-}
pattern GiB :: Integral n => n -> Size
pattern $mGiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bGiB :: forall n. Integral n => n -> Size
GiB { forall n. Integral n => Size -> n
gibibytes } <- (\(MiB n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1024 -> gibibytes)
  where
    GiB = n -> Size
forall n. Integral n => n -> Size
MiB (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE GiB #-}

{-| Construct a 'Size' from an integer in tebibytes

>>> format sz (TiB 42)
"46.179 TB"
>>> let GiB n = TiB 1 in n
1024
-}
pattern TiB :: Integral n => n -> Size
pattern $mTiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
$bTiB :: forall n. Integral n => n -> Size
TiB { forall n. Integral n => Size -> n
tebibytes } <- (\(GiB n
x) -> n
x n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
1024 -> tebibytes)
  where
    TiB = n -> Size
forall n. Integral n => n -> Size
GiB (n -> Size) -> (n -> n) -> n -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE TiB #-}

-- | Extract a size in bytes
bytes :: Integral n => Size -> n

-- | @1 kilobyte = 1000 bytes@
kilobytes :: Integral n => Size -> n

-- | @1 megabyte = 1000 kilobytes@
megabytes :: Integral n => Size -> n

-- | @1 gigabyte = 1000 megabytes@
gigabytes :: Integral n => Size -> n

-- | @1 terabyte = 1000 gigabytes@
terabytes :: Integral n => Size -> n

-- | @1 kibibyte = 1024 bytes@
kibibytes :: Integral n => Size -> n

-- | @1 mebibyte = 1024 kibibytes@
mebibytes :: Integral n => Size -> n

-- | @1 gibibyte = 1024 mebibytes@
gibibytes :: Integral n => Size -> n

-- | @1 tebibyte = 1024 gibibytes@
tebibytes :: Integral n => Size -> n

{-| Count the number of characters in the stream (like @wc -c@)

    This uses the convention that the elements of the stream are implicitly
    ended by newlines that are one character wide
-}
countChars :: Integral n => Fold Line n
countChars :: forall n. Integral n => Fold Line n
countChars =
  (Line -> Text) -> Fold Text n -> Fold Line n
forall a b r. (a -> b) -> Fold b r -> Fold a r
premap Line -> Text
lineToText Fold Text n
forall n. Num n => Fold Text n
Control.Foldl.Text.length Fold Line n -> Fold Line n -> Fold Line n
forall a. Num a => a -> a -> a
+
    Fold Line n
forall a. Num a => a
charsPerNewline Fold Line n -> Fold Line n -> Fold Line n
forall a. Num a => a -> a -> a
* Fold Line n
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

-- | Count the number of words in the stream (like @wc -w@)
countWords :: Integral n => Fold Line n
countWords :: forall n. Integral n => Fold Line n
countWords = (Line -> [Text]) -> Fold [Text] n -> Fold Line n
forall a b r. (a -> b) -> Fold b r -> Fold a r
premap (Text -> [Text]
Text.words (Text -> [Text]) -> (Line -> Text) -> Line -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Text
lineToText) (Handler [Text] Text -> Fold Text n -> Fold [Text] n
forall a b r. Handler a b -> Fold b r -> Fold a r
handles (Text -> Const (Dual (Endo x)) Text)
-> [Text] -> Const (Dual (Endo x)) [Text]
Handler [Text] Text
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Fold Text n
forall b a. Num b => Fold a b
genericLength)

{-| Count the number of lines in the stream (like @wc -l@)

    This uses the convention that each element of the stream represents one
    line
-}
countLines :: Integral n => Fold Line n
countLines :: forall n. Integral n => Fold Line n
countLines = Fold Line n
forall b a. Num b => Fold a b
genericLength

-- | Get the status of a file
stat :: MonadIO io => FilePath -> io PosixCompat.FileStatus
stat :: forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
stat = IO FileStatus -> io FileStatus
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> io FileStatus)
-> (FilePath -> IO FileStatus) -> FilePath -> io FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
PosixCompat.getFileStatus

-- | Size of the file in bytes. Does not follow symlinks
fileSize :: PosixCompat.FileStatus -> Size
fileSize :: FileStatus -> Size
fileSize = FileOffset -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset -> Size)
-> (FileStatus -> FileOffset) -> FileStatus -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
PosixCompat.fileSize

-- | Time of last access
accessTime :: PosixCompat.FileStatus -> POSIXTime
accessTime :: FileStatus -> POSIXTime
accessTime = EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> POSIXTime)
-> (FileStatus -> EpochTime) -> FileStatus -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.accessTime

-- | Time of last modification
modificationTime :: PosixCompat.FileStatus -> POSIXTime
modificationTime :: FileStatus -> POSIXTime
modificationTime = EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> POSIXTime)
-> (FileStatus -> EpochTime) -> FileStatus -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.modificationTime

-- | Time of last status change (i.e. owner, group, link count, mode, etc.)
statusChangeTime :: PosixCompat.FileStatus -> POSIXTime
statusChangeTime :: FileStatus -> POSIXTime
statusChangeTime = EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> POSIXTime)
-> (FileStatus -> EpochTime) -> FileStatus -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.statusChangeTime

-- | Get the status of a file, but don't follow symbolic links
lstat :: MonadIO io => FilePath -> io PosixCompat.FileStatus
lstat :: forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat = IO FileStatus -> io FileStatus
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> io FileStatus)
-> (FilePath -> IO FileStatus) -> FilePath -> io FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
PosixCompat.getSymbolicLinkStatus

data WithHeader a
    = Header a
    -- ^ The first line with the header
    | Row a a
    -- ^ Every other line: 1st element is header, 2nd element is original row
    deriving (Int -> WithHeader a -> ShowS
[WithHeader a] -> ShowS
WithHeader a -> FilePath
(Int -> WithHeader a -> ShowS)
-> (WithHeader a -> FilePath)
-> ([WithHeader a] -> ShowS)
-> Show (WithHeader a)
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
$cshowsPrec :: forall a. Show a => Int -> WithHeader a -> ShowS
showsPrec :: Int -> WithHeader a -> ShowS
$cshow :: forall a. Show a => WithHeader a -> FilePath
show :: WithHeader a -> FilePath
$cshowList :: forall a. Show a => [WithHeader a] -> ShowS
showList :: [WithHeader a] -> ShowS
Show)

data Pair a b = Pair !a !b

header :: Shell a -> Shell (WithHeader a)
header :: forall a. Shell a -> Shell (WithHeader a)
header (Shell forall r. FoldShell a r -> IO r
k) = (forall r. FoldShell (WithHeader a) r -> IO r)
-> Shell (WithHeader a)
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell FoldShell (WithHeader a) r -> IO r
forall r. FoldShell (WithHeader a) r -> IO r
k'
  where
    k' :: FoldShell (WithHeader a) b -> IO b
k' (FoldShell x -> WithHeader a -> IO x
step x
begin x -> IO b
done) = FoldShell a b -> IO b
forall r. FoldShell a r -> IO r
k ((Pair x (Maybe a) -> a -> IO (Pair x (Maybe a)))
-> Pair x (Maybe a) -> (Pair x (Maybe a) -> IO b) -> FoldShell a b
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' Pair x (Maybe a)
forall {a}. Pair x (Maybe a)
begin' Pair x (Maybe a) -> IO b
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 -> WithHeader a -> IO x
step x
x (a -> WithHeader a
forall a. a -> WithHeader a
Header a
a)
            return (Pair x' (Just a))
        step' (Pair x
x (Just a
a)) a
b = do
            x' <- x -> WithHeader a -> IO x
step x
x (a -> a -> WithHeader a
forall a. a -> a -> WithHeader a
Row a
a a
b)
            return (Pair x' (Just a))

        begin' :: Pair x (Maybe a)
begin' = x -> Maybe a -> Pair x (Maybe a)
forall a b. a -> b -> Pair a b
Pair x
begin Maybe a
forall a. Maybe a
Nothing

        done' :: Pair x b -> IO b
done' (Pair x
x b
_) = x -> IO b
done x
x

-- | Returns the result of a 'Shell' that outputs a single line.
-- Note that if no lines / more than 1 line is produced by the Shell, this function will `die` with an error message.
--
-- > main = do
-- >   directory <- single (inshell "pwd" empty)
-- >   print directory
single :: MonadIO io => Shell a -> io a
single :: forall (io :: * -> *) a. MonadIO io => Shell a -> io a
single Shell a
s = do
    as <- Shell a -> Fold a [a] -> io [a]
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell a
s Fold a [a]
forall a. Fold a [a]
Control.Foldl.list
    case as of
        [a
a] -> a -> io a
forall a. a -> io a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        [a]
_   -> do
            let msg :: Text
msg = Format Text (Int -> Text) -> Int -> Text
forall r. Format Text r -> r
format (Format (Int -> Text) (Int -> Text)
"single: expected 1 line of input but there were "Format (Int -> Text) (Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Int -> Text)
forall n r. Integral n => Format r (n -> r)
dFormat Text (Int -> Text)
-> Format Text Text -> Format Text (Int -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" lines of input") ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as)
            Text -> io a
forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
msg

-- | Filter adjacent duplicate elements:
--
-- >>> view (uniq (select [1,1,2,1,3]))
-- 1
-- 2
-- 1
-- 3
uniq :: Eq a => Shell a -> Shell a
uniq :: forall a. Eq a => Shell a -> Shell a
uniq = (a -> a) -> Shell a -> Shell a
forall b a. Eq b => (a -> b) -> Shell a -> Shell a
uniqOn a -> a
forall a. a -> a
id

-- | Filter adjacent duplicates determined after applying the function to the element:
--
-- >>> view (uniqOn fst (select [(1,'a'),(1,'b'),(2,'c'),(1,'d'),(3,'e')]))
-- (1,'a')
-- (2,'c')
-- (1,'d')
-- (3,'e')
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 = (a -> a -> Bool) -> Shell a -> Shell a
forall a. (a -> a -> Bool) -> Shell a -> Shell a
uniqBy (\a
a a
a' -> a -> b
f a
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== a -> b
f a
a')

-- | Filter adjacent duplicate elements determined via the given function:
--
-- >>> view (uniqBy (==) (select [1,1,2,1,3]))
-- 1
-- 2
-- 1
-- 3
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 r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell ((forall r. FoldShell a r -> IO r) -> Shell a)
-> (forall r. FoldShell a r -> IO r) -> Shell a
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' = (x, Maybe a) -> IO (x, Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
      step' (x
x, Maybe a
_) a
a = (, a -> Maybe a
forall a. a -> Maybe a
Just a
a) (x -> (x, Maybe a)) -> IO x -> IO (x, Maybe 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, Maybe a
forall a. Maybe a
Nothing)
      done' :: (x, b) -> IO r
done' (x
x, b
_) = x -> IO r
done x
x
  Shell a -> FoldShell a r -> IO r
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> FoldShell a b -> io b
foldShell Shell a
s (((x, Maybe a) -> a -> IO (x, Maybe a))
-> (x, Maybe a) -> ((x, Maybe a) -> IO r) -> FoldShell a r
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' (x, Maybe a)
forall {a}. (x, Maybe a)
begin' (x, Maybe a) -> IO r
forall {b}. (x, b) -> IO r
done')

-- | Return a new `Shell` that discards duplicates from the input `Shell`:
--
-- >>> view (nub (select [1, 1, 2, 3, 3, 4, 3]))
-- 1
-- 2
-- 3
-- 4
nub :: Ord a => Shell a -> Shell a
nub :: forall a. Ord a => Shell a -> Shell a
nub = (a -> a) -> Shell a -> Shell a
forall b a. Ord b => (a -> b) -> Shell a -> Shell a
nubOn a -> a
forall a. a -> a
id

-- | Return a new `Shell` that discards duplicates determined via the given function from the input `Shell`:
--
-- >>> view (nubOn id (select [1, 1, 2, 3, 3, 4, 3]))
-- 1
-- 2
-- 3
-- 4
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 r. FoldShell a r -> IO r) -> Shell a
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell ((forall r. FoldShell a r -> IO r) -> Shell a)
-> (forall r. FoldShell a r -> IO r) -> Shell a
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 | b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (a -> b
f a
a) Set b
bs = (x, Set b) -> IO (x, Set b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, Set b
bs)
                      | Bool
otherwise = (, b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert (a -> b
f a
a) Set b
bs) (x -> (x, Set b)) -> IO x -> IO (x, Set b)
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, Set a
forall a. Set a
Set.empty)
      done' :: (x, b) -> IO r
done' (x
x, b
_) = x -> IO r
done x
x
  Shell a -> FoldShell a r -> IO r
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> FoldShell a b -> io b
foldShell Shell a
s (((x, Set b) -> a -> IO (x, Set b))
-> (x, Set b) -> ((x, Set b) -> IO r) -> FoldShell a r
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' (x, Set b)
forall {a}. (x, Set a)
begin' (x, Set b) -> IO r
forall {b}. (x, b) -> IO r
done')

-- | Return a list of the sorted elements of the given `Shell`, keeping duplicates:
--
-- >>> sort (select [1,4,2,3,3,7])
-- [1,2,3,3,4,7]
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 = (a -> a) -> Shell a -> io [a]
forall (io :: * -> *) b a.
(Functor io, MonadIO io, Ord b) =>
(a -> b) -> Shell a -> io [a]
sortOn a -> a
forall a. a -> a
id

-- | Return a list of the elements of the given `Shell`, sorted after applying the given function and keeping duplicates:
--
-- >>> sortOn id (select [1,4,2,3,3,7])
-- [1,2,3,3,4,7]
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 = (a -> a -> Ordering) -> Shell a -> io [a]
forall (io :: * -> *) a.
(Functor io, MonadIO io) =>
(a -> a -> Ordering) -> Shell a -> io [a]
sortBy ((a -> b) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> b
f)

-- | Return a list of the elements of the given `Shell`, sorted by the given function and keeping duplicates:
--
-- >>> sortBy (comparing fst) (select [(1,'a'),(4,'b'),(2,'c'),(3,'d'),(3,'e'),(7,'f')])
-- [(1,'a'),(2,'c'),(3,'d'),(3,'e'),(4,'b'),(7,'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 = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy a -> a -> Ordering
f ([a] -> [a]) -> io [a] -> io [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Shell a -> Fold a [a] -> io [a]
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell a
s Fold a [a]
forall a. Fold a [a]
list

{-| Group an arbitrary stream of `Text` into newline-delimited `Line`s

>>> stdout (toLines ("ABC" <|> "DEF" <|> "GHI")
ABCDEFGHI
>>> stdout (toLines empty)  -- Note that this always emits at least 1 `Line`

>>> stdout (toLines ("ABC\nDEF" <|> "" <|> "GHI\nJKL"))
ABC
DEFGHI
JKL
-}
toLines :: Shell Text -> Shell Line
toLines :: Shell Text -> Shell Line
toLines (Shell forall r. FoldShell Text r -> IO r
k) = (forall r. FoldShell Line r -> IO r) -> Shell Line
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell FoldShell Line r -> IO r
forall r. FoldShell Line r -> IO r
k'
  where
    k' :: FoldShell Line b -> IO b
k' (FoldShell x -> Line -> IO x
step x
begin x -> IO b
done) =
        FoldShell Text b -> IO b
forall r. FoldShell Text r -> IO r
k ((Pair x Line -> Text -> IO (Pair x Line))
-> Pair x Line -> (Pair x Line -> IO b) -> FoldShell Text b
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 Line -> Line -> Line
forall a. Semigroup a => a -> a -> a
<> Line
suffix

            let lines' :: NonEmpty Line
lines' = Line
line Line -> [Line] -> NonEmpty Line
forall a. a -> [a] -> NonEmpty a
:| [Line]
lines

            x' <- (x -> Line -> IO x) -> x -> [Line] -> IO 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 (NonEmpty Line -> [Line]
forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Line
lines')

            let prefix' = NonEmpty Line -> Line
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Line
lines'

            return (Pair x' prefix')

        begin' :: Pair x Line
begin' = (x -> Line -> Pair x Line
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 -> Line -> IO x
step x
x Line
prefix
            done x'