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

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

module Turtle.Prelude (
    -- * IO
      echo
    , err
    , readline
    , Internal.readTextFile
    , Internal.writeTextFile
    , arguments
#if __GLASGOW_HASKELL__ >= 710
    , export
    , unset
#endif
    , need
    , env
    , cd
    , pwd
    , home
    , readlink
    , realpath
    , mv
    , mkdir
    , mktree
    , cp
    , cptree
    , cptreeL
#if !defined(mingw32_HOST_OS)
    , symlink
#endif
    , isNotSymbolicLink
    , rm
    , rmdir
    , rmtree
    , testfile
    , testdir
    , testpath
    , date
    , datefile
    , touch
    , time
    , hostname
    , which
    , whichAll
    , sleep
    , exit
    , die
    , (.&&.)
    , (.||.)

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

    -- * Shell
    , stdin
    , input
    , inhandle
    , stdout
    , output
    , outhandle
    , append
    , stderr
    , strict
    , ls
    , lsif
    , lstree
    , lsdepth
    , cat
    , grep
    , grepText
    , sed
    , sedPrefix
    , sedSuffix
    , sedEntire
    , onFiles
    , inplace
    , inplacePrefix
    , inplaceSuffix
    , inplaceEntire
    , update
    , find
    , findtree
    , yes
    , nl
    , paste
    , endless
    , limit
    , limitWhile
    , cache
    , parallel
    , single
    , uniq
    , uniqOn
    , uniqBy
    , nub
    , nubOn
    , sort
    , sortOn
    , sortBy
    , toLines

    -- * Folds
    , countChars
    , countWords
    , countLines

    -- * Text
    , cut

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

    , system
    , stream
    , streamWithErr
    , systemStrict
    , systemStrictWithErr

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

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

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

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

    -- * Exceptions
    , ProcFailed(..)
    , ShellFailed(..)
    ) where

import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
    (Async, withAsync, waitSTM, concurrently,
     Concurrently(..))
import qualified Control.Concurrent.Async
import Control.Concurrent.MVar (newMVar, modifyMVar_)
import qualified Control.Concurrent.STM as STM
import qualified Control.Concurrent.STM.TQueue as TQueue
import Control.Exception (Exception, bracket, bracket_, finally, mask, throwIO)
import Control.Foldl (Fold(..), genericLength, handles, list, premap)
import qualified Control.Foldl
import qualified Control.Foldl.Text
import Control.Monad (foldM, guard, liftM, msum, when, unless, (>=>), mfilter)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Managed (MonadManaged(..), managed, managed_, runManaged)
#ifdef mingw32_HOST_OS
import Data.Bits ((.&.))
#endif
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Monoid ((<>))
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text, pack, unpack)
import Data.Time (NominalDiffTime, UTCTime, getCurrentTime)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)
import Data.Traversable
import qualified Data.Text    as Text
import qualified Data.Text.IO as Text
import Data.Typeable (Typeable)
import GHC.IO.Exception (IOErrorType(UnsupportedOperation))
import Network.HostName (getHostName)
import System.Clock (Clock(..), TimeSpec(..), getTime)
import System.Environment (
    getArgs,
#if __GLASGOW_HASKELL__ >= 710
    setEnv,
    unsetEnv,
#endif
#if __GLASGOW_HASKELL__ >= 708
    lookupEnv,
#endif
    getEnvironment )
import qualified System.Directory as Directory
import System.FilePath ((</>))
import qualified System.FilePath as FilePath
import System.Exit (ExitCode(..), exitWith)
import System.IO (Handle, hClose)
import qualified System.IO as IO
import System.IO.Temp (withTempDirectory, withTempFile)
import System.IO.Error
    (catchIOError, ioeGetErrorType, isPermissionError, isDoesNotExistError)
import qualified System.PosixCompat as PosixCompat
import qualified System.Process as Process
#ifdef mingw32_HOST_OS
import qualified System.Win32 as Win32
#else
import System.Posix (
    openDirStream,
    readDirStream,
    closeDirStream,
    touchFile )
import System.Posix.Files (createSymbolicLink)      
#endif
import Prelude hiding (lines)

import Turtle.Pattern (Pattern, anyChar, chars, match, selfless, sepBy)
import Turtle.Shell
import Turtle.Format (Format, format, makeFormat, d, w, (%), fp)
import qualified Turtle.Internal as Internal
import Turtle.Line

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

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

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

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

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

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

instance Exception ProcFailed

{-| This function is identical to `proc` except this throws `ProcFailed` for
    non-zero exit codes
-}
procs
    :: MonadIO io
    => Text
    -- ^ Command
    -> [Text]
    -- ^ Arguments
    -> Shell Line
    -- ^ Lines of standard input
    -> io ()
procs :: forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ()
procs Text
cmd [Text]
args Shell Line
s = do
    ExitCode
exitCode <- forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ExitCode
proc Text
cmd [Text]
args Shell Line
s
    case ExitCode
exitCode of
        ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitCode
_           -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO (Text -> [Text] -> ExitCode -> ProcFailed
ProcFailed Text
cmd [Text]
args ExitCode
exitCode))

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

instance Exception ShellFailed

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

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

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

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

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

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

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

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

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

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

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

    -- Prevent double close
    MVar Bool
mvar <- forall a. a -> IO (MVar a)
newMVar Bool
False
    let close :: Handle -> IO ()
close Handle
handle = do
            forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Bool
mvar (\Bool
finalized -> do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finalized (IO () -> IO ()
Internal.ignoreSIGPIPE (Handle -> IO ()
hClose Handle
handle))
                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
    let close' :: (Maybe Handle, ProcessHandle) -> IO ()
close' (Just Handle
hIn, ProcessHandle
ph) = do
            Handle -> IO ()
close Handle
hIn
            ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph
        close' (Maybe Handle
Nothing , ProcessHandle
ph) = do
            ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph

    let handle :: (Maybe Handle, ProcessHandle) -> IO ExitCode
handle (Just Handle
hIn, ProcessHandle
ph) = do
            let feedIn :: (forall a. IO a -> IO a) -> IO ()
                feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
                    forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn
            forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore ->
                forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\Async ()
a ->
                    forall a. IO a -> IO a
restore (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph) forall a b. IO a -> IO b -> IO a
`finally` forall a. Async a -> IO ()
halt Async ()
a) )
        handle (Maybe Handle
Nothing , ProcessHandle
ph) = do
            ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph

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


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

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

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

    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph) (\(Handle
hIn, Handle
hOut, ProcessHandle
ph) -> do
        let feedIn :: (forall a. IO a -> IO a) -> IO ()
            feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
                forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

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

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

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

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

    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph) (\(Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph) -> do
        let feedIn :: (forall a. IO a -> IO a) -> IO ()
            feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore =
                forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

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

{-| 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) (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   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ExitFailure Int
_ -> forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExitCode
exitCode

{-| `stream` 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
            Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
            forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, ProcessHandle
ph)

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

    (Handle
hIn, Handle
hOut, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
    let feedIn :: (forall a. IO a -> IO a) -> IO ()
        feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore = forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

    Async ()
a <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
        (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (\Async () -> IO r
k ->
            forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (\forall a. IO a -> IO a
restore -> forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (forall a. IO a -> IO a
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> IO r
k))))
    Handle -> Shell Line
inhandle Handle
hOut forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Async a -> IO ()
halt Async ()
a) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a
empty)

{-| `streamWithErr` 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
            Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hIn BufferMode
IO.LineBuffering
            forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph)

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

    (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph) <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(Handle
hIn, Handle
_, Handle
_, ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
    let feedIn :: (forall a. IO a -> IO a) -> IO ()
        feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore = forall a. IO a -> IO a
restore (IO () -> IO ()
Internal.ignoreSIGPIPE (forall (io :: * -> *). MonadIO io => Handle -> Shell Line -> io ()
outhandle Handle
hIn Shell Line
s)) forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
close Handle
hIn

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

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

{-| 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) (forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack [Text]
args))

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

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

    Throws an `ExitCode` exception if the command returns a non-zero exit code
-}
inshellWithErr
    :: Text
    -- ^ Command line
    -> Shell Line
    -- ^ Lines of standard input
    -> Shell (Either Line Line)
    -- ^ Lines of either standard output (`Right`) or standard error (`Left`)
inshellWithErr :: Text -> Shell Line -> Shell (Either Line Line)
inshellWithErr Text
cmd = CreateProcess -> Shell Line -> Shell (Either Line Line)
streamWithErr (FilePath -> CreateProcess
Process.shell (Text -> FilePath
unpack Text
cmd))

{-| Print exactly one line to @stdout@

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

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

{-| Read in a line from @stdin@

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

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

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

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

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

-- | Look up an environment variable
need :: MonadIO io => Text -> io (Maybe Text)
#if __GLASGOW_HASKELL__ >= 708
need :: forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
need Text
key = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
pack) (FilePath -> IO (Maybe FilePath)
lookupEnv (Text -> FilePath
unpack Text
key)))
#else
need key = liftM (lookup key) env
#endif

-- | Retrieve all environment variables
env :: MonadIO io => io [(Text, Text)]
env :: forall (io :: * -> *). MonadIO io => io [(Text, Text)]
env = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, FilePath) -> (Text, Text)
toTexts) IO [(FilePath, FilePath)]
getEnvironment)
  where
    toTexts :: (FilePath, FilePath) -> (Text, Text)
toTexts (FilePath
key, FilePath
val) = (FilePath -> Text
pack FilePath
key, FilePath -> Text
pack FilePath
val)

{-| Change the current directory

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

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

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

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

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

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

-- | Canonicalize a path
realpath :: MonadIO io => FilePath -> io FilePath
realpath :: forall (io :: * -> *). MonadIO io => FilePath -> io FilePath
realpath FilePath
path = 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 a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell x -> FilePath -> IO x
step x
begin x -> IO r
done) -> do
    let path' :: FilePath
path' = FilePath
path
    Bool
canRead <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
         Permissions -> Bool
Directory.readable
        (FilePath -> IO Permissions
Directory.getPermissions (ShowS
deslash FilePath
path'))
#ifdef mingw32_HOST_OS
    reparse <- fmap reparsePoint (Win32.getFileAttributes path')
    if (canRead && not reparse)
        then bracket
            (Win32.findFirstFile (path </> "*"))
            (\(h, _) -> Win32.findClose h)
            (\(h, fdat) -> do
                let loop x = do
                        file <- Win32.getFindDataFileName fdat
                        x' <- if (file /= "." && file /= "..")
                            then step x (path </> file)
                            else return x
                        more <- Win32.findNextFile h fdat
                        if more then loop $! x' else done x'
                loop $! begin )
        else done begin )
#else
    if Bool
canRead
        then forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO DirStream
openDirStream FilePath
path') DirStream -> IO ()
closeDirStream (\DirStream
dirp -> do
            let loop :: x -> IO r
loop x
x = do
                    FilePath
file <- DirStream -> IO FilePath
readDirStream DirStream
dirp
                    case FilePath
file of
                        FilePath
"" -> x -> IO r
done x
x
                        FilePath
_  -> do
                            x
x' <- if (FilePath
file forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
file forall a. Eq a => a -> a -> Bool
/= FilePath
"..")
                                then x -> FilePath -> IO x
step x
x (FilePath
path FilePath -> ShowS
</> FilePath
file)
                                else forall (m :: * -> *) a. Monad m => a -> m a
return x
x
                            x -> IO r
loop forall a b. (a -> b) -> a -> b
$! x
x'
            x -> IO r
loop forall a b. (a -> b) -> a -> b
$! x
begin )
        else x -> IO r
done x
begin )
#endif

{-| 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
c0forall a. a -> [a] -> [a]
:ShowS
go FilePath
cs0
  where
    go :: ShowS
go []     = []
    go [Char
'\\'] = []
    go (Char
c:FilePath
cs) = Char
cforall a. a -> [a] -> [a]
:ShowS
go FilePath
cs

-- | 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 <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
    if Bool
isDir
        then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Shell FilePath
lstree FilePath
child
        else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child


{- | 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 forall a. Ord a => a -> a -> Bool
> Int
u
      then forall (f :: * -> *) a. Alternative f => f a
empty
      else do
        FilePath
child <- FilePath -> Shell FilePath
ls FilePath
p
        Bool
isDir <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
        if Bool
isDir
          then if Int
depth forall a. Ord a => a -> a -> Bool
>= Int
l
               then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper (Int
depth forall a. Num a => a -> a -> a
+ Int
1) Int
l Int
u FilePath
child
               else Int -> Int -> Int -> FilePath -> Shell FilePath
lsdepthHelper (Int
depth forall a. Num a => a -> a -> a
+ Int
1) Int
l Int
u FilePath
child
          else if Int
depth forall a. Ord a => a -> a -> Bool
>= Int
l
               then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
               else forall (f :: * -> *) a. Alternative f => f a
empty

{-| 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 <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testdir FilePath
child
    if Bool
isDir
        then do
            Bool
continue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
predicate FilePath
child)
            if Bool
continue
                then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath -> IO Bool) -> FilePath -> Shell FilePath
lsif FilePath -> IO Bool
predicate FilePath
child
                else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child
        else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
child

{-| Move a file or directory

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

{-| Create a directory

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

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

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

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

#if !defined(mingw32_HOST_OS)
-- | Create a symlink from one @FilePath@ to another
symlink :: MonadIO io => FilePath -> FilePath -> io ()
symlink :: forall (io :: * -> *). MonadIO io => FilePath -> FilePath -> io ()
symlink FilePath
a FilePath
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createSymbolicLink (ShowS
fp2fp FilePath
a) (ShowS
fp2fp FilePath
b)
  where
    fp2fp :: ShowS
fp2fp = Text -> FilePath
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Format Text r -> r
format forall r. Format r (FilePath -> r)
fp 
  
#endif

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

    This comes in handy in conjunction with `lsif`:

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

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

    -- 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 <- forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> Maybe FilePath
Internal.stripPrefix (FilePath
oldTree forall a. Semigroup a => a -> a -> a
<> [ Char
FilePath.pathSeparator ]) FilePath
oldPath)

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

    Creates an empty file if it does not exist
-}
touch :: MonadIO io => FilePath -> io ()
touch :: forall (io :: * -> *). MonadIO io => FilePath -> io ()
touch FilePath
file = do
    Bool
exists <- forall (io :: * -> *). MonadIO io => FilePath -> io Bool
testfile FilePath
file
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (if Bool
exists
#ifdef mingw32_HOST_OS
        then do
            handle <- Win32.createFile
                file
                Win32.gENERIC_WRITE
                Win32.fILE_SHARE_NONE
                Nothing
                Win32.oPEN_EXISTING
                Win32.fILE_ATTRIBUTE_NORMAL
                Nothing
            (creationTime, _, _) <- Win32.getFileTime handle
            systemTime <- Win32.getSystemTimeAsFileTime
            Win32.setFileTime handle (Just creationTime) (Just systemTime) (Just systemTime)
#else
        then FilePath -> IO ()
touchFile FilePath
file
#endif
        else forall (io :: * -> *).
MonadIO io =>
FilePath -> Shell Line -> io ()
output FilePath
file forall (f :: * -> *) a. Alternative f => f a
empty )

{-| 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c== :: Permissions -> Permissions -> Bool
Eq, ReadPrec [Permissions]
ReadPrec Permissions
Int -> ReadS Permissions
ReadS [Permissions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Permissions]
$creadListPrec :: ReadPrec [Permissions]
readPrec :: ReadPrec Permissions
$creadPrec :: ReadPrec Permissions
readList :: ReadS [Permissions]
$creadList :: ReadS [Permissions]
readsPrec :: Int -> ReadS Permissions
$creadsPrec :: Int -> ReadS Permissions
Read, Eq Permissions
Permissions -> Permissions -> Bool
Permissions -> Permissions -> Ordering
Permissions -> Permissions -> Permissions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmax :: Permissions -> Permissions -> Permissions
>= :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c< :: Permissions -> Permissions -> Bool
compare :: Permissions -> Permissions -> Ordering
$ccompare :: Permissions -> Permissions -> Ordering
Ord, Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Permissions] -> ShowS
$cshowList :: [Permissions] -> ShowS
show :: Permissions -> FilePath
$cshow :: Permissions -> FilePath
showsPrec :: Int -> Permissions -> ShowS
$cshowsPrec :: Int -> Permissions -> ShowS
Show)

{-| 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)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Permissions -> Permissions
Directory.setOwnerWritable   (Permissions -> Bool
_writable   Permissions
p)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Permissions -> Permissions
Directory.setOwnerExecutable (Permissions -> Bool
_executable Permissions
p)
    ) Permissions
Directory.emptyPermissions

fromSystemDirectoryPermissions :: Directory.Permissions -> Permissions
fromSystemDirectoryPermissions :: Permissions -> Permissions
fromSystemDirectoryPermissions Permissions
p = Permissions
    { _readable :: Bool
_readable   = Permissions -> Bool
Directory.readable Permissions
p
    , _writable :: Bool
_writable   = Permissions -> Bool
Directory.writable Permissions
p
    , _executable :: Bool
_executable =
        Permissions -> Bool
Directory.executable Permissions
p Bool -> Bool -> Bool
|| Permissions -> Bool
Directory.searchable Permissions
p
    }

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

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

    The meaning of each permission is:

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

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

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

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

-- | Set a file or directory's user permissions
setmod :: MonadIO io => Permissions -> FilePath -> io ()
setmod :: forall (io :: * -> *).
MonadIO io =>
Permissions -> FilePath -> io ()
setmod Permissions
permissions FilePath
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
    let path' :: FilePath
path' = ShowS
deslash FilePath
path
    FilePath -> Permissions -> IO ()
Directory.setPermissions FilePath
path' (Permissions -> Permissions
toSystemDirectoryPermissions Permissions
permissions) )

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

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

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

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

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

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

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

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

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

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

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

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

  forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isExecutable
  forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path'

{-| Sleep for the given duration

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

{-| Exit with the given exit code

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

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

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

{-| Analogous to `&&` in Bash

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

{-| Analogous to `||` in Bash

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

{-| Create a temporary directory underneath the given directory

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

{-| Create a temporary file underneath the given directory

    Deletes the temporary file when done

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

{-| Create a temporary file underneath the given directory

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

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

-- | Wait for an `Async` action to complete
wait :: MonadIO io => Async a -> io a
wait :: forall (io :: * -> *) a. MonadIO io => Async a -> io a
wait Async a
a = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 <- forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
readonly FilePath
file)
    Handle -> Shell Line
inhandle Handle
handle

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

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

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

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

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

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

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

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

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

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

-- | Combine the output of multiple `Shell`s, in order
cat :: [Shell a] -> Shell a
cat :: forall a. [Shell a] -> Shell a
cat = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum

grepWith :: (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith :: forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith b -> Text
f Pattern a
pattern' = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pattern a -> Text -> [a]
match Pattern a
pattern' forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Text
f)

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

-- | Keep every `Text` element that matches the given `Pattern`
grepText :: Pattern a -> Shell Text -> Shell Text
grepText :: forall a. Pattern a -> Shell Text -> Shell Text
grepText = forall b a. (b -> Text) -> Pattern a -> Shell b -> Shell b
grepWith 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {a}. Pattern a -> Bool
matchesEmpty Pattern Text
pattern') (forall (io :: * -> *) a. MonadIO io => Text -> io a
die Text
message)
    let pattern'' :: Pattern Text
pattern'' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat
            (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Pattern Text
pattern' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton Pattern Char
anyChar))
    Line
line   <- Shell Line
s
    Text
txt':[Text]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match Pattern Text
pattern'' (Line -> Text
lineToText Line
line))
    forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')
  where
    message :: Text
message = Text
"sed: the given pattern matches the empty string"
    matchesEmpty :: Pattern a -> Bool
matchesEmpty = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Pattern a -> Text -> [a]
match Text
""

{-| 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]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match ((Pattern Text
pattern' forall a. Semigroup a => a -> a -> a
<> Pattern Text
chars) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars) (Line -> Text
lineToText Line
line))
    forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')

-- | 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]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match ((Pattern Text
chars forall a. Semigroup a => a -> a -> a
<> Pattern Text
pattern') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars) (Line -> Text
lineToText Line
line))
    forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')

-- | 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]
_ <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pattern a -> Text -> [a]
match (Pattern Text
pattern' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern Text
chars)(Line -> Text
lineToText Line
line))
    forall (f :: * -> *) a. Foldable f => f a -> Shell a
select (Text -> NonEmpty Line
textToLines Text
txt')

-- | 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shell Text -> Shell Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Text.pack

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

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

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

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

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

    For example, this is used to implement the @inplace*@ family of utilities
-}
update :: MonadIO io => (Shell Line -> Shell Line) -> FilePath -> io ()
update :: forall (io :: * -> *).
MonadIO io =>
(Shell Line -> Shell Line) -> FilePath -> io ()
update Shell Line -> Shell Line
f FilePath
file = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Managed () -> IO ()
runManaged (do
    FilePath
here <- forall (io :: * -> *). MonadIO io => io FilePath
pwd

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Number each element of a `Shell` (starting at 0)
nl :: Num n => Shell a -> Shell (n, a)
nl :: forall n a. Num n => Shell a -> Shell (n, a)
nl Shell a
s = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b} {b}. Num b => FoldShell (b, a) b -> IO b
_foldShell'
  where
    _foldShell' :: FoldShell (b, a) b -> IO b
_foldShell' (FoldShell x -> (b, a) -> IO x
step x
begin x -> IO b
done) = forall a. Shell a -> forall r. FoldShell a r -> IO r
_foldShell Shell a
s (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell (x, b) -> a -> IO (x, b)
step' (x, b)
begin' forall {b}. (x, b) -> IO b
done')
      where
        step' :: (x, b) -> a -> IO (x, b)
step' (x
x, b
n) a
a = do
            x
x' <- x -> (b, a) -> IO x
step x
x (b
n, a
a)
            let n' :: b
n' = b
n forall a. Num a => a -> a -> a
+ b
1
            b
n' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (x
x', b
n')
        begin' :: (x, b)
begin' = (x
begin, b
0)
        done' :: (x, b) -> IO b
done' (x
x, b
_) = x -> IO b
done x
x

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

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

    If one `Shell` is longer than the other, the excess elements are
    truncated
-}
paste :: Shell a -> Shell b -> Shell (a, b)
paste :: forall a b. Shell a -> Shell b -> Shell (a, b)
paste Shell a
sA Shell b
sB = forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b}. FoldShell (a, b) b -> IO b
_foldShellAB
  where
    _foldShellAB :: FoldShell (a, b) b -> IO b
_foldShellAB (FoldShell x -> (a, b) -> IO x
stepAB x
beginAB x -> IO b
doneAB) = do
        TVar (ZipState a b)
tvar <- forall a. STM a -> IO a
STM.atomically (forall a. a -> STM (TVar a)
STM.newTVar forall a b. ZipState a b
Empty)

        let begin :: ()
begin = ()

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

{-| 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
Ord, Integer -> Size
Size -> Size
Size -> Size -> Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Size
$cfromInteger :: Integer -> Size
signum :: Size -> Size
$csignum :: Size -> Size
abs :: Size -> Size
$cabs :: Size -> Size
negate :: Size -> Size
$cnegate :: Size -> Size
* :: Size -> Size -> Size
$c* :: Size -> Size -> Size
- :: Size -> Size -> Size
$c- :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c+ :: Size -> Size -> Size
Num)

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

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

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

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

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

{-| 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 :: forall n. Integral n => n -> Size
$mKB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
KB { forall n. Integral n => Size -> n
kilobytes } <- (\(B n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> kilobytes)
  where
    KB = forall n. Integral n => n -> Size
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE KB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mMB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
MB { forall n. Integral n => Size -> n
megabytes } <- (\(KB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> megabytes)
  where
    MB = forall n. Integral n => n -> Size
KB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE MB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mGB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
GB { forall n. Integral n => Size -> n
gigabytes } <- (\(MB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> gigabytes)
  where
    GB = forall n. Integral n => n -> Size
MB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE GB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mTB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
TB { forall n. Integral n => Size -> n
terabytes } <- (\(GB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1000 -> terabytes)
  where
    TB = forall n. Integral n => n -> Size
GB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1000)
{-# COMPLETE TB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mKiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
KiB { forall n. Integral n => Size -> n
kibibytes } <- (\(B n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> kibibytes)
  where
    KiB = forall n. Integral n => n -> Size
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE KiB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mMiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
MiB { forall n. Integral n => Size -> n
mebibytes } <- (\(KiB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> mebibytes)
  where
    MiB = forall n. Integral n => n -> Size
KiB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE MiB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mGiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
GiB { forall n. Integral n => Size -> n
gibibytes } <- (\(MiB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> gibibytes)
  where
    GiB = forall n. Integral n => n -> Size
MiB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE GiB #-}

{-| 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 :: forall n. Integral n => n -> Size
$mTiB :: forall {r} {n}. Integral n => Size -> (n -> r) -> ((# #) -> r) -> r
TiB { forall n. Integral n => Size -> n
tebibytes } <- (\(GiB n
x) -> n
x forall a. Integral a => a -> a -> a
`div` n
1024 -> tebibytes)
  where
    TiB = forall n. Integral n => n -> Size
GiB forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* n
1024)
{-# COMPLETE TiB #-}

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

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

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

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

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

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

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

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

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

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

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

charsPerNewline :: Num a => a
#ifdef mingw32_HOST_OS
charsPerNewline = 2
#else
charsPerNewline :: forall a. Num a => a
charsPerNewline = a
1
#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{-| 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 a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall {b}. FoldShell Line b -> IO b
k'
  where
    k' :: FoldShell Line b -> IO b
k' (FoldShell x -> Line -> IO x
step x
begin x -> IO b
done) =
        forall r. FoldShell Text r -> IO r
k (forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell Pair x Line -> Text -> IO (Pair x Line)
step' Pair x Line
begin' Pair x Line -> IO b
done')
      where
        step' :: Pair x Line -> Text -> IO (Pair x Line)
step' (Pair x
x Line
prefix) Text
text = do
            let Line
suffix :| [Line]
lines = Text -> NonEmpty Line
Turtle.Line.textToLines Text
text

            let line :: Line
line = Line
prefix forall a. Semigroup a => a -> a -> a
<> Line
suffix

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

            x
x' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM x -> Line -> IO x
step x
x (forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Line
lines')

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

            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Pair a b
Pair x
x' Line
prefix')

        begin' :: Pair x Line
begin' = (forall a b. a -> b -> Pair a b
Pair x
begin Line
"")

        done' :: Pair x Line -> IO b
done' (Pair x
x Line
prefix) = do
            x
x' <- x -> Line -> IO x
step x
x Line
prefix
            x -> IO b
done x
x'