{-# 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 :: 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))
            { std_in :: StdStream
Process.std_in  = StdStream
Process.CreatePipe
            , std_out :: StdStream
Process.std_out = StdStream
Process.Inherit
            , std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
            } )

{-| 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 :: 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))
            { std_in :: StdStream
Process.std_in  = StdStream
Process.CreatePipe
            , std_out :: StdStream
Process.std_out = StdStream
Process.Inherit
            , std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
            } )

data ProcFailed = ProcFailed
    { ProcFailed -> Text
procCommand   :: Text
    , ProcFailed -> [Text]
procArguments :: [Text]
    , ProcFailed -> ExitCode
procExitCode  :: ExitCode
    } deriving (Int -> ProcFailed -> ShowS
[ProcFailed] -> ShowS
ProcFailed -> FilePath
(Int -> ProcFailed -> ShowS)
-> (ProcFailed -> FilePath)
-> ([ProcFailed] -> ShowS)
-> Show ProcFailed
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProcFailed] -> ShowS
$cshowList :: [ProcFailed] -> ShowS
show :: ProcFailed -> FilePath
$cshow :: ProcFailed -> FilePath
showsPrec :: Int -> ProcFailed -> ShowS
$cshowsPrec :: Int -> ProcFailed -> ShowS
Show, Typeable)

instance Exception ProcFailed

{-| 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 :: Text -> [Text] -> Shell Line -> io ()
procs Text
cmd [Text]
args Shell Line
s = do
    ExitCode
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
exitCode of
        ExitCode
ExitSuccess -> () -> io ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitCode
_           -> IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcFailed -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Text -> [Text] -> ExitCode -> ProcFailed
ProcFailed Text
cmd [Text]
args ExitCode
exitCode))

data ShellFailed = ShellFailed
    { ShellFailed -> Text
shellCommandLine :: Text
    , ShellFailed -> ExitCode
shellExitCode    :: ExitCode
    } deriving (Int -> ShellFailed -> ShowS
[ShellFailed] -> ShowS
ShellFailed -> FilePath
(Int -> ShellFailed -> ShowS)
-> (ShellFailed -> FilePath)
-> ([ShellFailed] -> ShowS)
-> Show ShellFailed
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ShellFailed] -> ShowS
$cshowList :: [ShellFailed] -> ShowS
show :: ShellFailed -> FilePath
$cshow :: ShellFailed -> FilePath
showsPrec :: Int -> ShellFailed -> ShowS
$cshowsPrec :: Int -> ShellFailed -> ShowS
Show, Typeable)

instance Exception ShellFailed

{-| 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 :: Text -> Shell Line -> io ()
shells Text
cmdline Shell Line
s = do
    ExitCode
exitCode <- Text -> Shell Line -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
Text -> Shell Line -> io ExitCode
shell Text
cmdline Shell Line
s
    case ExitCode
exitCode of
        ExitCode
ExitSuccess -> () -> io ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitCode
_           -> IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ShellFailed -> IO ()
forall e a. 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 :: 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 :: 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 :: 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 :: 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 :: Async a -> IO ()
halt Async a
a = do
    Maybe (Either SomeException a)
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 Maybe (Either SomeException a)
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. Exception e => e -> IO a
throwIO SomeException
e
        Just (Right a
_) -> () -> IO ()
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 :: CreateProcess -> Shell Line -> io ExitCode
system CreateProcess
p Shell Line
s = IO ExitCode -> io ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let open :: IO (Maybe Handle, ProcessHandle)
open = do
            (Maybe Handle
m, Maybe Handle
Nothing, Maybe Handle
Nothing, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p
            case Maybe Handle
m of
                Just Handle
hIn -> Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
                Maybe Handle
_        -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            (Maybe Handle, ProcessHandle) -> IO (Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
m, ProcessHandle
ph)

    -- Prevent double close
    MVar Bool
mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
    let close :: Handle -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
    let close' :: (Maybe Handle, ProcessHandle) -> IO ()
close' (Just Handle
hIn, ProcessHandle
ph) = do
            Handle -> IO ()
close Handle
hIn
            ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph
        close' (Maybe Handle
Nothing , ProcessHandle
ph) = do
            ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph

    let handle :: (Maybe Handle, ProcessHandle) -> IO ExitCode
handle (Just Handle
hIn, ProcessHandle
ph) = do
            let feedIn :: (forall a. IO a -> IO a) -> IO ()
                feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
                    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 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

    IO (Maybe Handle, ProcessHandle)
-> ((Maybe Handle, ProcessHandle) -> IO ())
-> ((Maybe Handle, ProcessHandle) -> IO ExitCode)
-> IO ExitCode
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Maybe Handle, ProcessHandle)
open (Maybe Handle, ProcessHandle) -> IO ()
close' (Maybe Handle, ProcessHandle) -> IO ExitCode
handle )


{-| `systemStrict` 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 :: CreateProcess -> Shell Line -> io (ExitCode, Text)
systemStrict CreateProcess
p Shell Line
s = IO (ExitCode, Text) -> io (ExitCode, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let p' :: CreateProcess
p' = CreateProcess
p
            { std_in :: StdStream
Process.std_in  = StdStream
Process.CreatePipe
            , std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
            , std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
            }

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

    -- Prevent double close
    MVar Bool
mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
    let close :: Handle -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    IO (Handle, Handle, ProcessHandle)
-> ((Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, ProcessHandle) -> IO (ExitCode, Text))
-> IO (ExitCode, Text)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
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 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 (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 :: CreateProcess -> Shell Line -> io (ExitCode, Text, Text)
systemStrictWithErr CreateProcess
p Shell Line
s = IO (ExitCode, Text, Text) -> io (ExitCode, Text, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let p' :: CreateProcess
p' = CreateProcess
p
            { std_in :: StdStream
Process.std_in  = StdStream
Process.CreatePipe
            , std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
            , std_err :: StdStream
Process.std_err = StdStream
Process.CreatePipe
            }

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

    -- Prevent double close
    MVar Bool
mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
    let close :: Handle -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    IO (Handle, Handle, Handle, ProcessHandle)
-> ((Handle, Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, Handle, ProcessHandle)
    -> IO (ExitCode, Text, Text))
-> IO (ExitCode, Text, Text)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
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 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 (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 (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 (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
exitCode <- ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph
    case ExitCode
exitCode of
        ExitCode
ExitSuccess   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitFailure Int
_ -> ExitCode -> IO ()
forall e a. 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
            { std_in :: StdStream
Process.std_in  = StdStream
Process.CreatePipe
            , std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
            , std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
            }

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

    -- Prevent double close
    MVar Bool
mvar <- IO (MVar Bool) -> Shell (MVar Bool)
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 -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    (Handle
hIn, Handle
hOut, ProcessHandle
ph) <- Managed (Handle, Handle, ProcessHandle)
-> Shell (Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. ((Handle, Handle, ProcessHandle) -> IO r) -> IO r)
-> Managed (Handle, Handle, ProcessHandle)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (IO (Handle, Handle, ProcessHandle)
-> ((Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, ProcessHandle) -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
    let feedIn :: (forall a. IO a -> IO a) -> IO ()
        feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore = 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

    Async ()
a <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
        ((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
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 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))))
    Handle -> Shell Line
inhandle Handle
hOut Shell Line -> Shell Line -> Shell Line
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a) Shell () -> Shell Line -> Shell Line
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Shell Line
forall (f :: * -> *) a. Alternative f => f 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
            { std_in :: StdStream
Process.std_in  = StdStream
Process.CreatePipe
            , std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
            , std_err :: StdStream
Process.std_err = StdStream
Process.CreatePipe
            }

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

    -- Prevent double close
    MVar Bool
mvar <- IO (MVar Bool) -> Shell (MVar Bool)
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 -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True )

    (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph) <- Managed (Handle, Handle, Handle, ProcessHandle)
-> Shell (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r.
 ((Handle, Handle, Handle, ProcessHandle) -> IO r) -> IO r)
-> Managed (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (IO (Handle, Handle, Handle, ProcessHandle)
-> ((Handle, Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, Handle, ProcessHandle) -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
    let feedIn :: (forall a. IO a -> IO a) -> IO ()
        feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore = 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

    TQueue (Maybe (Either Line Line))
queue <- IO (TQueue (Maybe (Either Line Line)))
-> Shell (TQueue (Maybe (Either Line Line)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TQueue (Maybe (Either Line Line)))
forall a. IO (TQueue a)
TQueue.newTQueueIO
    let forwardOut :: (forall a. IO a -> IO a) -> IO ()
        forwardOut :: (forall a. IO a -> IO a) -> IO ()
forwardOut forall a. IO a -> IO a
restore =
            IO () -> IO ()
forall a. IO a -> IO a
restore (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
                Line
line <- Handle -> Shell Line
inhandle Handle
hOut
                IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 (Either Line Line -> Maybe (Either Line Line)
forall a. a -> Maybe a
Just (Line -> Either Line Line
forall a b. b -> Either a b
Right Line
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) -> 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
line <- Handle -> Shell Line
inhandle Handle
hErr
                IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 (Either Line Line -> Maybe (Either Line Line)
forall a. a -> Maybe a
Just (Line -> Either Line Line
forall a b. a -> Either a b
Left  Line
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 :: Shell (Either Line Line)
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
                        Maybe (Either Line Line)
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 Maybe (Either Line Line)
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' <- x -> Either Line Line -> IO x
step x
x Either Line Line
e
                                x -> a -> IO x
loop x
x' a
numNothing
                    | Bool
otherwise      = x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
            x
x1 <- x -> Int -> IO x
forall a. (Ord a, Num a) => x -> a -> IO x
loop x
begin (Int
0 :: Int)
            x -> IO r
done x
x1 )

    Async ()
a <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
        ((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
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 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)) ))
    Async ()
b <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
        ((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
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 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)) ))
    Async ()
c <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
        ((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
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 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 -> STM a -> STM ()
`also` STM a
r = do
            a
_ <- STM a
l 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> STM a
forall a. STM a
STM.retry)
            a
_ <- STM a
r
            () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    let waitAll :: IO ()
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))
    Shell (Either Line Line)
drain Shell (Either Line Line)
-> Shell (Either Line Line) -> Shell (Either Line Line)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
waitAll) Shell () -> Shell (Either Line Line) -> Shell (Either Line Line)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Shell (Either Line Line)
forall (f :: * -> *) a. Alternative f => f a
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 :: Line -> io ()
echo Line
line = IO () -> io ()
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 :: Line -> io ()
err Line
line = IO () -> io ()
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 :: io (Maybe Line)
readline = IO (Maybe Line) -> io (Maybe Line)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    Bool
eof <- IO Bool
IO.isEOF
    if Bool
eof
        then Maybe Line -> IO (Maybe Line)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Line
forall a. Maybe a
Nothing
        else (FilePath -> Maybe Line) -> IO FilePath -> IO (Maybe Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Line -> Maybe Line
forall a. a -> Maybe a
Just (Line -> Maybe Line)
-> (FilePath -> Line) -> FilePath -> Maybe Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Line
unsafeTextToLine (Text -> Line) -> (FilePath -> Text) -> FilePath -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) IO FilePath
getLine )

-- | Get command line arguments in a list
arguments :: MonadIO io => io [Text]
arguments :: io [Text]
arguments = IO [Text] -> io [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (([FilePath] -> [Text]) -> IO [FilePath] -> IO [Text]
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 :: Text -> Text -> io ()
export Text
key Text
val = IO () -> io ()
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 :: Text -> io ()
unset Text
key = IO () -> io ()
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 :: Text -> io (Maybe Text)
need Text
key = IO (Maybe Text) -> io (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Maybe FilePath -> Maybe Text)
-> IO (Maybe FilePath) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Text) -> Maybe FilePath -> Maybe Text
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 :: io [(Text, Text)]
env = IO [(Text, Text)] -> io [(Text, Text)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (([(FilePath, FilePath)] -> [(Text, Text)])
-> IO [(FilePath, FilePath)] -> IO [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((FilePath, FilePath) -> (Text, Text))
-> [(FilePath, FilePath)] -> [(Text, Text)]
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 :: FilePath -> io ()
cd FilePath
path = IO () -> io ()
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 :: FilePath -> managed ()
pushd FilePath
path = do
    FilePath
cwd <- managed FilePath
forall (io :: * -> *). MonadIO io => io FilePath
pwd
    Managed () -> managed ()
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall a. IO a -> IO a) -> Managed ()
forall (m :: * -> *).
MonadManaged m =>
(forall a. IO a -> IO a) -> m ()
managed_ (IO () -> IO () -> IO r -> IO r
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (FilePath -> IO ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
cd FilePath
path) (FilePath -> IO ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
cd FilePath
cwd)))

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

-- | Get the home directory
home :: MonadIO io => io FilePath
home :: io FilePath
home = IO FilePath -> io FilePath
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 :: FilePath -> io FilePath
readlink FilePath
path = IO FilePath -> io FilePath
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 :: FilePath -> io FilePath
realpath FilePath
path = IO FilePath -> io FilePath
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
    Bool
canRead <- (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
         Permissions -> Bool
Directory.readable
        (FilePath -> IO Permissions
Directory.getPermissions (ShowS
deslash FilePath
path'))
#ifdef mingw32_HOST_OS
    reparse <- fmap reparsePoint (Win32.getFileAttributes path')
    if (canRead && not reparse)
        then bracket
            (Win32.findFirstFile (path </> "*"))
            (\(h, _) -> Win32.findClose h)
            (\(h, fdat) -> do
                let loop x = do
                        file <- Win32.getFindDataFileName fdat
                        x' <- if (file /= "." && file /= "..")
                            then step x (path </> file)
                            else return x
                        more <- Win32.findNextFile h fdat
                        if more then loop $! x' else done x'
                loop $! begin )
        else done begin )
#else
    if Bool
canRead
        then IO DirStream -> (DirStream -> IO ()) -> (DirStream -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO DirStream
openDirStream FilePath
path') DirStream -> IO ()
closeDirStream (\DirStream
dirp -> do
            let loop :: x -> IO r
loop x
x = do
                    FilePath
file <- DirStream -> IO FilePath
readDirStream DirStream
dirp
                    case FilePath
file of
                        FilePath
"" -> x -> IO r
done x
x
                        FilePath
_  -> do
                            x
x' <- if (FilePath
file 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 (m :: * -> *) a. Monad m => a -> m a
return x
x
                            x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
x'
            x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
begin )
        else x -> IO r
done x
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
    FilePath
child <- FilePath -> Shell FilePath
ls FilePath
path
    Bool
isDir <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
    if Bool
isDir
        then FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child Shell FilePath -> Shell FilePath -> Shell FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Shell FilePath
lstree FilePath
child
        else FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
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 (f :: * -> *) a. Alternative f => f a
empty
      else do
        FilePath
child <- FilePath -> Shell FilePath
ls FilePath
p
        Bool
isDir <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
        if Bool
isDir
          then if Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
               then FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child Shell FilePath -> Shell FilePath -> Shell FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
l Int
u FilePath
child
               else Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
l Int
u FilePath
child
          else if Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
               then FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
               else Shell FilePath
forall (f :: * -> *) a. Alternative f => f a
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
    FilePath
child <- FilePath -> Shell FilePath
ls FilePath
path
    Bool
isDir <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
    if Bool
isDir
        then do
            Bool
continue <- IO Bool -> Shell Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
predicate FilePath
child)
            if Bool
continue
                then FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child Shell FilePath -> Shell FilePath -> Shell FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
predicate FilePath
child
                else FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
        else FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
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 :: FilePath -> FilePath -> io ()
mv FilePath
oldPath FilePath
newPath = IO () -> io ()
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 :: FilePath -> io ()
mkdir FilePath
path = IO () -> io ()
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 :: FilePath -> io ()
mktree FilePath
path = IO () -> io ()
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 :: FilePath -> FilePath -> io ()
cp FilePath
oldPath FilePath
newPath = IO () -> io ()
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 :: FilePath -> FilePath -> io ()
symlink FilePath
a FilePath
b = IO () -> io ()
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 :: FilePath -> io Bool
isNotSymbolicLink = (FileStatus -> Bool) -> io FileStatus -> io Bool
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 :: FilePath -> FilePath -> io ()
cptree FilePath
oldTree FilePath
newTree = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    FilePath
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 FilePath
suffix <- Maybe FilePath -> Shell (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> Maybe FilePath
Internal.stripPrefix (FilePath
oldTree FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ Char
FilePath.pathSeparator ]) FilePath
oldPath)

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

    Bool
isFile <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
oldPath

    FileStatus
fileStatus <- FilePath -> Shell FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
oldPath

    if FileStatus -> Bool
PosixCompat.isSymbolicLink FileStatus
fileStatus
        then do
            FilePath
oldTarget <- IO FilePath -> Shell FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
PosixCompat.readSymbolicLink FilePath
oldPath)

            FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree (ShowS
FilePath.takeDirectory FilePath
newPath)

            IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO ()
PosixCompat.createSymbolicLink FilePath
oldTarget FilePath
newPath)
        else if Bool
isFile
        then do
            FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree (ShowS
FilePath.takeDirectory FilePath
newPath)

            FilePath -> FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
cp FilePath
oldPath FilePath
newPath
        else do
            FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
mktree FilePath
newPath )

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


-- | Remove a file
rm :: MonadIO io => FilePath -> io ()
rm :: FilePath -> io ()
rm FilePath
path = IO () -> io ()
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 :: FilePath -> io ()
rmdir FilePath
path = IO () -> io ()
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 :: FilePath -> io ()
rmtree FilePath
path0 = IO () -> io ()
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
        FileStatus
linkstat <- FilePath -> Shell FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
path
        let isLink :: Bool
isLink = FileStatus -> Bool
PosixCompat.isSymbolicLink FileStatus
linkstat
            isDir :: Bool
isDir = FileStatus -> Bool
PosixCompat.isDirectory FileStatus
linkstat
        if Bool
isLink
            then FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
rm FilePath
path
            else do
                if Bool
isDir
                    then (do
                        FilePath
child <- FilePath -> Shell FilePath
ls FilePath
path
                        FilePath -> Shell ()
loop FilePath
child ) Shell () -> Shell () -> Shell ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
rmdir FilePath
path
                    else FilePath -> Shell ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
rm FilePath
path

-- | Check if a file exists
testfile :: MonadIO io => FilePath -> io Bool
testfile :: FilePath -> io Bool
testfile FilePath
path = IO Bool -> io Bool
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 :: FilePath -> io Bool
testdir FilePath
path = IO Bool -> io Bool
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 :: FilePath -> io Bool
testpath FilePath
path = do
  Bool
exists <- FilePath -> io Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path
  if Bool
exists
    then Bool -> io Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
    else FilePath -> io Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
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 :: FilePath -> io ()
touch FilePath
file = do
    Bool
exists <- FilePath -> io Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
    IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (if Bool
exists
#ifdef mingw32_HOST_OS
        then do
            handle <- Win32.createFile
                file
                Win32.gENERIC_WRITE
                Win32.fILE_SHARE_NONE
                Nothing
                Win32.oPEN_EXISTING
                Win32.fILE_ATTRIBUTE_NORMAL
                Nothing
            (creationTime, _, _) <- Win32.getFileTime handle
            systemTime <- Win32.getSystemTimeAsFileTime
            Win32.setFileTime handle (Just creationTime) (Just systemTime) (Just systemTime)
#else
        then FilePath -> IO ()
touchFile FilePath
file
#endif
        else FilePath -> Shell Line -> IO ()
forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
output FilePath
file Shell Line
forall (f :: * -> *) a. Alternative f => f a
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
/= :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c== :: 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
readListPrec :: ReadPrec [Permissions]
$creadListPrec :: ReadPrec [Permissions]
readPrec :: ReadPrec Permissions
$creadPrec :: ReadPrec Permissions
readList :: ReadS [Permissions]
$creadList :: ReadS [Permissions]
readsPrec :: Int -> ReadS Permissions
$creadsPrec :: Int -> ReadS Permissions
Read, Eq Permissions
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
min :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmax :: Permissions -> Permissions -> Permissions
>= :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c< :: Permissions -> Permissions -> Bool
compare :: Permissions -> Permissions -> Ordering
$ccompare :: Permissions -> Permissions -> Ordering
$cp1Ord :: Eq 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
showList :: [Permissions] -> ShowS
$cshowList :: [Permissions] -> ShowS
show :: Permissions -> FilePath
$cshow :: Permissions -> FilePath
showsPrec :: Int -> Permissions -> ShowS
$cshowsPrec :: Int -> 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 :: Bool -> Bool -> Bool -> Permissions
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 :: (Permissions -> Permissions) -> FilePath -> io Permissions
chmod Permissions -> Permissions
modifyPermissions FilePath
path = IO Permissions -> io Permissions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let path' :: FilePath
path' = ShowS
deslash FilePath
path
    Permissions
permissions <- FilePath -> IO Permissions
Directory.getPermissions FilePath
path'
    let permissions' :: Permissions
permissions' = Permissions -> Permissions
fromSystemDirectoryPermissions Permissions
permissions
    let permissions'' :: Permissions
permissions'' = Permissions -> Permissions
modifyPermissions Permissions
permissions'
        changed :: Bool
changed = Permissions
permissions' Permissions -> Permissions -> Bool
forall a. Eq a => a -> a -> Bool
/= Permissions
permissions''
    let permissions''' :: Permissions
permissions''' = Permissions -> Permissions
toSystemDirectoryPermissions Permissions
permissions''
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
path' Permissions
permissions''')
    Permissions -> IO Permissions
forall (m :: * -> *) a. Monad m => a -> m a
return Permissions
permissions'' )

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

-- | Set a file or directory's user permissions
setmod :: MonadIO io => Permissions -> FilePath -> io ()
setmod :: Permissions -> FilePath -> io ()
setmod Permissions
permissions FilePath
path = IO () -> io ()
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 :: FilePath -> FilePath -> io ()
copymod FilePath
sourcePath FilePath
targetPath = IO () -> io ()
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 :: Bool
_readable = Bool
True }

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

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

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

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

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

-- | @-r -w -x@
ooo :: Permissions -> Permissions
ooo :: Permissions -> Permissions
ooo Permissions
_ = Permissions :: Bool -> Bool -> Bool -> 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 :: io a -> io (a, NominalDiffTime)
time io a
io = do
    TimeSpec Int64
seconds1 Int64
nanoseconds1 <- IO TimeSpec -> io TimeSpec
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
    a
a <- io a
io
    TimeSpec Int64
seconds2 Int64
nanoseconds2 <- IO TimeSpec -> io TimeSpec
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
    let t :: Rational
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)
    (a, NominalDiffTime) -> io (a, NominalDiffTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational Rational
t)

-- | Get the system's host name
hostname :: MonadIO io => io Text
hostname :: io Text
hostname = IO Text -> io Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> Text) -> IO FilePath -> IO Text
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 :: 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 Text
paths <- Text -> Shell (Maybe Text)
forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
need Text
"PATH"
  FilePath
path <- [FilePath] -> Shell FilePath
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select ((Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack (Text -> Text -> [Text]
Text.splitOn Text
":" Text
paths))
  let path' :: FilePath
path' = FilePath
path FilePath -> ShowS
</> FilePath
cmd

  Bool
True <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
path'

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

  let getIsExecutable :: IO Bool
getIsExecutable = (Permissions -> Bool) -> IO Permissions -> IO Bool
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')
  Bool
isExecutable <- IO Bool -> Shell Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
getIsExecutable IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` IOError -> IO Bool
handler)

  Bool -> Shell ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isExecutable
  FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
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 :: NominalDiffTime -> io ()
sleep NominalDiffTime
n = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay (NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime
n NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
10NominalDiffTime -> Int -> NominalDiffTime
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 :: ExitCode -> io a
exit ExitCode
code = 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 :: Text -> io a
die Text
txt = IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOError -> IO a
forall e a. 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 .&&. :: m ExitCode -> m ExitCode -> m ExitCode
.&&. m ExitCode
cmd2 = do
    ExitCode
r <- m ExitCode
cmd1
    case ExitCode
r of
        ExitCode
ExitSuccess -> m ExitCode
cmd2
        ExitCode
_           -> ExitCode -> m ExitCode
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 .||. :: m ExitCode -> m ExitCode -> m ExitCode
.||. m ExitCode
cmd2 = do
    ExitCode
r <- m ExitCode
cmd1
    case ExitCode
r of
        ExitFailure Int
_ -> m ExitCode
cmd2
        ExitCode
_             -> ExitCode -> m ExitCode
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 :: FilePath -> Text -> managed FilePath
mktempdir FilePath
parent Text
prefix = Managed FilePath -> managed FilePath
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 :: FilePath -> Text -> managed (FilePath, Handle)
mktemp FilePath
parent Text
prefix = Managed (FilePath, Handle) -> managed (FilePath, Handle)
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
    let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
    (FilePath
file', Handle
handle) <- (forall 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)) )
    (FilePath, Handle) -> Managed (FilePath, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file', Handle
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 :: FilePath -> Text -> managed FilePath
mktempfile FilePath
parent Text
prefix = Managed FilePath -> managed FilePath
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (do
    let prefix' :: FilePath
prefix' = Text -> FilePath
unpack Text
prefix
    (FilePath
file', Handle
handle) <- (forall 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)) )
    IO () -> Managed ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle)
    FilePath -> Managed FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
file' )

-- | Fork a thread, acquiring an `Async` value
fork :: MonadManaged managed => IO a -> managed (Async a)
fork :: IO a -> managed (Async a)
fork IO a
io = Managed (Async a) -> managed (Async 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 :: Async a -> io a
wait Async a
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
handle <- Managed Handle -> Shell Handle
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
readonly FilePath
file)
    Handle -> Shell Line
inhandle Handle
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
            Bool
eof <- Handle -> IO Bool
IO.hIsEOF Handle
handle
            if Bool
eof
                then x -> IO r
done x
x
                else do
                    Text
txt <- Handle -> IO Text
Text.hGetLine Handle
handle
                    x
x'  <- x -> Line -> IO x
step x
x (Text -> Line
unsafeTextToLine Text
txt)
                    x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
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 :: Shell Line -> io ()
stdout Shell Line
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
    Line
line <- Shell Line
s
    IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Line -> IO ()
forall (io :: * -> *). MonadIO io => Line -> io ()
echo Line
line) )

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

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

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

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

-- | Read in a stream's contents strictly
strict :: MonadIO io => Shell Line -> io Text
strict :: 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 :: FilePath -> managed Handle
readonly FilePath
file = Managed Handle -> managed Handle
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 :: FilePath -> managed Handle
writeonly FilePath
file = Managed Handle -> managed Handle
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 :: FilePath -> managed Handle
appendonly FilePath
file = Managed Handle -> managed Handle
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 :: [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 :: (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 (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 :: 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 :: 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat
            (Pattern Text -> Pattern [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Pattern Text
pattern' Pattern Text -> Pattern Text -> Pattern Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Text) -> Pattern Char -> Pattern Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton Pattern Char
anyChar))
    Line
line   <- Shell Line
s
    Text
txt':[Text]
_ <- [Text] -> Shell [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Text -> Text -> [Text]
forall a. Pattern a -> Text -> [a]
match Pattern Text
pattern'' (Line -> Text
lineToText Line
line))
    NonEmpty Line -> Shell Line
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')
  where
    message :: Text
message = Text
"sed: the given pattern matches the empty string"
    matchesEmpty :: Pattern a -> Bool
matchesEmpty = Bool -> Bool
not (Bool -> Bool) -> (Pattern a -> Bool) -> Pattern a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
line   <- Shell Line
s
    Text
txt':[Text]
_ <- [Text] -> Shell [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Text -> Text -> [Text]
forall a. Pattern a -> Text -> [a]
match ((Pattern Text
pattern' Pattern Text -> Pattern Text -> Pattern Text
forall a. Semigroup a => a -> a -> a
<> Pattern Text
chars) Pattern Text -> Pattern Text -> Pattern Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars) (Line -> Text
lineToText Line
line))
    NonEmpty Line -> Shell Line
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
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
line   <- Shell Line
s
    Text
txt':[Text]
_ <- [Text] -> Shell [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Text -> Text -> [Text]
forall a. Pattern a -> Text -> [a]
match ((Pattern Text
chars Pattern Text -> Pattern Text -> Pattern Text
forall a. Semigroup a => a -> a -> a
<> Pattern Text
pattern') Pattern Text -> Pattern Text -> Pattern Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars) (Line -> Text
lineToText Line
line))
    NonEmpty Line -> Shell Line
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
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
line   <- Shell Line
s
    Text
txt':[Text]
_ <- [Text] -> Shell [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern Text -> Text -> [Text]
forall a. Pattern a -> Text -> [a]
match (Pattern Text
pattern' Pattern Text -> Pattern Text -> Pattern Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars)(Line -> Text
lineToText Line
line))
    NonEmpty Line -> Shell Line
forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
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 (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 (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 :: 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 :: 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 :: 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 :: 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 :: (Shell Line -> Shell Line) -> FilePath -> io ()
update Shell Line -> Shell Line
f FilePath
file = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Managed () -> IO ()
runManaged (do
    FilePath
here <- Managed FilePath
forall (io :: * -> *). MonadIO io => io FilePath
pwd

    (FilePath
tmpfile, Handle
handle) <- FilePath -> Text -> Managed (FilePath, Handle)
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> Text -> managed (FilePath, Handle)
mktemp FilePath
here Text
"turtle"

    Handle -> Shell Line -> Managed ()
forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
handle (Shell Line -> Shell Line
f (FilePath -> Shell Line
input FilePath
file))

    IO () -> Managed ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle)

    FilePath -> FilePath -> Managed ()
forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
copymod FilePath
file FilePath
tmpfile

    FilePath -> FilePath -> Managed ()
forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
mv FilePath
tmpfile FilePath
file ))

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

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

    a
_:[a]
_ <- [a] -> Shell [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern a -> Text -> [a]
forall a. Pattern a -> Text -> [a]
match Pattern a
pattern' Text
txt)

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

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

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

  a
_:[a]
_ <- [a] -> Shell [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern a -> Text -> [a]
forall a. Pattern a -> Text -> [a]
match Pattern a
pat Text
txt)

  FilePath -> Shell FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path

{- | Check if a file was last modified after a given
     timestamp
-}     
cmin :: MonadIO io => UTCTime -> FilePath -> io Bool
cmin :: UTCTime -> FilePath -> io Bool
cmin UTCTime
t FilePath
file = do
  FileStatus
status <- FilePath -> io FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
  Bool -> io Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> Bool
adapt FileStatus
status)
  where
    adapt :: FileStatus -> Bool
adapt FileStatus
x = NominalDiffTime -> UTCTime
posixSecondsToUTCTime (FileStatus -> NominalDiffTime
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 :: UTCTime -> FilePath -> io Bool
cmax UTCTime
t FilePath
file = do
  FileStatus
status <- FilePath -> io FileStatus
forall (io :: * -> *). MonadIO io => FilePath -> io FileStatus
lstat FilePath
file
  Bool -> io Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (FileStatus -> Bool
adapt FileStatus
status)
  where
    adapt :: FileStatus -> Bool
adapt FileStatus
x = NominalDiffTime -> UTCTime
posixSecondsToUTCTime (FileStatus -> NominalDiffTime
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 (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 :: 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 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 -> FoldShell a b -> IO b
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' <- x -> (b, a) -> IO x
step x
x (b
n, a
a)
            let n' :: b
n' = b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
            b
n' b -> IO (x, b) -> IO (x, b)
`seq` (x, b) -> IO (x, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x', b
n')
        begin' :: (x, b)
begin' = (x
begin, b
0)
        done' :: (x, b) -> IO b
done' (x
x, b
_) = x -> IO b
done x
x

data ZipState a b = Empty | HasA a | HasAB a b | Done

{-| 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 :: 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 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 (ZipState a b)
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 :: ()
begin = ()

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

        IO () -> (Async () -> IO b) -> IO b
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (Shell a -> FoldShell a () -> IO ()
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
sA FoldShell a ()
foldA) (\Async ()
asyncA -> do
            IO () -> (Async () -> IO b) -> IO b
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (Shell b -> FoldShell b () -> IO ()
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell b
sB FoldShell b ()
foldB) (\Async ()
asyncB -> do
                let loop :: x -> IO x
loop x
x = do
                        Maybe (a, b)
y <- STM (Maybe (a, b)) -> IO (Maybe (a, b))
forall a. STM a -> IO a
STM.atomically (do
                            ZipState a b
z <- TVar (ZipState a b) -> STM (ZipState a b)
forall a. TVar a -> STM a
STM.readTVar TVar (ZipState a b)
tvar
                            case ZipState a b
z of
                                HasAB a
a b
b -> do
                                    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 (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 (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 Maybe (a, b)
y of
                            Maybe (a, b)
Nothing -> x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
                            Just (a, b)
ab -> do
                                x
x' <- x -> (a, b) -> IO x
stepAB x
x (a, b)
ab
                                x -> IO x
loop (x -> IO x) -> x -> IO x
forall a b. (a -> b) -> a -> b
$! x
x'
                x
x' <- x -> IO x
loop (x -> IO x) -> x -> IO x
forall a b. (a -> b) -> a -> b
$! x
beginAB
                Async () -> IO ()
forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async ()
asyncA
                Async () -> IO ()
forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async ()
asyncB
                x -> IO b
doneAB x
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' <- x -> () -> IO x
step x
x ()
            x -> IO b
loop (x -> IO b) -> x -> IO b
forall a b. (a -> b) -> a -> b
$! x
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 :: 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
    IORef Int
ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0  -- I feel so dirty
    let step' :: x -> a -> IO x
step' x
x a
a = do
            Int
n' <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
ref
            IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then x -> a -> IO x
step x
x a
a else x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
    Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s ((x -> a -> IO x) -> x -> (x -> IO r) -> FoldShell a r
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step' x
begin x -> IO r
done) )

{-| 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 :: (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
    IORef Bool
ref <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
    let step' :: x -> a -> IO x
step' x
x a
a = do
            Bool
b <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
ref
            let b' :: Bool
b' = Bool
b Bool -> Bool -> Bool
&& a -> Bool
predicate a
a
            IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
b'
            if Bool
b' then x -> a -> IO x
step x
x a
a else x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
    Shell a -> FoldShell a r -> IO r
forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s ((x -> a -> IO x) -> x -> (x -> IO r) -> FoldShell a r
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell x -> a -> IO x
step' x
begin x -> IO r
done) )

{-| Cache 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 :: FilePath -> Shell a -> Shell a
cache FilePath
file Shell a
s = do
    let cached :: Shell (Maybe a)
cached = do
            Line
line <- FilePath -> Shell Line
input FilePath
file
            case ReadS (Maybe a)
forall a. Read a => ReadS a
reads (Text -> FilePath
Text.unpack (Line -> Text
lineToText Line
line)) of
                [(Maybe a
ma, FilePath
"")] -> Maybe a -> Shell (Maybe 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)
    Bool
exists <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
    [Maybe a]
mas    <- Shell (Maybe a) -> Fold (Maybe a) [Maybe a] -> Shell [Maybe a]
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold (if Bool
exists then Shell (Maybe a)
cached else Shell (Maybe a)
forall (f :: * -> *) a. Alternative f => f a
empty) Fold (Maybe a) [Maybe a]
forall a. Fold a [a]
list
    case [ () | Maybe a
Nothing <- [Maybe a]
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
handle <- Managed Handle -> Shell Handle
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 :: Shell a
justs = do
                    a
a      <- Shell a
s
                    IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
handle (FilePath -> Text
Text.pack (Maybe a -> FilePath
forall a. Show a => a -> FilePath
show (a -> Maybe a
forall a. a -> Maybe a
Just a
a))))
                    a -> Shell a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
            let nothing :: Shell b
nothing = do
                    let n :: Maybe ()
n = Maybe ()
forall a. Maybe a
Nothing :: Maybe ()
                    IO () -> Shell ()
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 (f :: * -> *) a. Alternative f => f a
empty
            Shell a
justs Shell a -> Shell a -> Shell a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Shell a
forall b. Shell b
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 :: [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)
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 :: Pattern a -> Text -> [Text]
cut Pattern a
pattern' Text
txt = [[Text]] -> [Text]
forall a. [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 :: io UTCTime
date = IO UTCTime -> io UTCTime
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 :: FilePath -> io UTCTime
datefile FilePath
path = IO UTCTime -> io UTCTime
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 :: FilePath -> io Size
du FilePath
path = IO Size -> io Size
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    Bool
isDir <- FilePath -> IO Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
path
    Integer
size <- do
        if Bool
isDir
        then do
            let sizes :: Shell Integer
sizes = do
                    FilePath
child <- FilePath -> Shell FilePath
lstree FilePath
path
                    Bool
True  <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
child
                    IO Integer -> Shell Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Integer
Directory.getFileSize FilePath
child)
            Shell Integer -> Fold Integer Integer -> IO Integer
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell Integer
sizes Fold Integer Integer
forall a. Num a => Fold a a
Control.Foldl.sum
        else FilePath -> IO Integer
Directory.getFileSize FilePath
path
    Size -> IO Size
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Size
Size Integer
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
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: 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
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> Size
$cfromInteger :: Integer -> Size
signum :: Size -> Size
$csignum :: Size -> Size
abs :: Size -> Size
$cabs :: Size -> Size
negate :: Size -> Size
$cnegate :: Size -> Size
* :: Size -> Size -> Size
$c* :: Size -> Size -> Size
- :: Size -> Size -> Size
$c- :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c+ :: Size -> Size -> Size
Num)

instance Show Size where
    show :: Size -> FilePath
show = 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 :: 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 $bB :: n -> Size
$mB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
B { Size -> Integral n => 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 $bKB :: n -> Size
$mKB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
KB { Size -> Integral n => n
kilobytes } <- (\(B x) -> x `div` 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 $bMB :: n -> Size
$mMB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
MB { Size -> Integral n => n
megabytes } <- (\(KB x) -> x `div` 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 $bGB :: n -> Size
$mGB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
GB { Size -> Integral n => n
gigabytes } <- (\(MB x) -> x `div` 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 $bTB :: n -> Size
$mTB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
TB { Size -> Integral n => n
terabytes } <- (\(GB x) -> x `div` 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 $bKiB :: n -> Size
$mKiB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
KiB { Size -> Integral n => n
kibibytes } <- (\(B x) -> x `div` 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 $bMiB :: n -> Size
$mMiB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
MiB { Size -> Integral n => n
mebibytes } <- (\(KiB x) -> x `div` 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 $bGiB :: n -> Size
$mGiB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
GiB { Size -> Integral n => n
gibibytes } <- (\(MiB x) -> x `div` 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 $bTiB :: n -> Size
$mTiB :: forall r n. Integral n => Size -> (n -> r) -> (Void# -> r) -> r
TiB { Size -> Integral n => n
tebibytes } <- (\(GiB x) -> x `div` 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 :: 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 :: a
charsPerNewline = a
1
#endif

-- | Count the number of words in the stream (like @wc -w@)
countWords :: Integral n => Fold Line n
countWords :: 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 Handler [Text] Text
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 :: 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 :: FilePath -> io FileStatus
stat = IO FileStatus -> io FileStatus
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 -> NominalDiffTime
accessTime = EpochTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> NominalDiffTime)
-> (FileStatus -> EpochTime) -> FileStatus -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
PosixCompat.accessTime

-- | Time of last modification
modificationTime :: PosixCompat.FileStatus -> POSIXTime
modificationTime :: FileStatus -> NominalDiffTime
modificationTime = EpochTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> NominalDiffTime)
-> (FileStatus -> EpochTime) -> FileStatus -> NominalDiffTime
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 -> NominalDiffTime
statusChangeTime = EpochTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> NominalDiffTime)
-> (FileStatus -> EpochTime) -> FileStatus -> NominalDiffTime
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 :: FilePath -> io FileStatus
lstat = IO FileStatus -> io FileStatus
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
showList :: [WithHeader a] -> ShowS
$cshowList :: forall a. Show a => [WithHeader a] -> ShowS
show :: WithHeader a -> FilePath
$cshow :: forall a. Show a => WithHeader a -> FilePath
showsPrec :: Int -> WithHeader a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithHeader a -> ShowS
Show)

data Pair a b = Pair !a !b

header :: Shell a -> Shell (WithHeader a)
header :: 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 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' <- x -> WithHeader a -> IO x
step x
x (a -> WithHeader a
forall a. a -> WithHeader a
Header a
a)
            Pair x (Maybe a) -> IO (Pair x (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Maybe a -> Pair x (Maybe a)
forall a b. a -> b -> Pair a b
Pair x
x' (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
        step' (Pair x
x (Just a
a)) a
b = do
            x
x' <- x -> WithHeader a -> IO x
step x
x (a -> a -> WithHeader a
forall a. a -> a -> WithHeader a
Row a
a a
b)
            Pair x (Maybe a) -> IO (Pair x (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Maybe a -> Pair x (Maybe a)
forall a b. a -> b -> Pair a b
Pair x
x' (a -> Maybe a
forall a. a -> Maybe a
Just a
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 :: Shell a -> io a
single Shell a
s = do
    [a]
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 [a]
as of
        [a
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 (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 :: 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 :: (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 :: (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 (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 :: 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 :: (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 (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 :: 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 :: (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 :: (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 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' <- (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' :: Line
prefix' = NonEmpty Line -> Line
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Line
lines'

            Pair x Line -> IO (Pair x Line)
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Line -> Pair x Line
forall a b. a -> b -> Pair a b
Pair x
x' Line
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' <- x -> Line -> IO x
step x
x Line
prefix
            x -> IO b
done x
x'