{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE ViewPatterns      #-}

{-|
Module      : GHCup.Utils.File
Description : File and unix APIs
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : POSIX

This module handles file and executable handling.
Some of these functions use sophisticated logging.
-}
module GHCup.Utils.File where

import           GHCup.Utils.Prelude
import           GHCup.Types

import           Control.Concurrent
import           Control.Concurrent.Async
import           Control.Exception              ( evaluate )
import           Control.Exception.Safe
import           Control.Monad
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.State.Strict
import           Data.ByteString                ( ByteString )
import           Data.Foldable
import           Data.Functor
import           Data.IORef
import           Data.Maybe
import           Data.Sequence                  ( Seq, (|>) )
import           Data.String.Interpolate
import           Data.Text                      ( Text )
import           Data.Void
import           Data.Word8
import           GHC.IO.Exception
import           HPath
import           HPath.IO                hiding ( hideError )
import           Optics                  hiding ((<|), (|>))
import           System.Console.Pretty   hiding ( Pretty )
import           System.Console.Regions
import           System.IO.Error
import           System.Posix.Directory.ByteString
import           System.Posix.FD               as FD
import           System.Posix.FilePath   hiding ( (</>) )
import           System.Posix.Files.ByteString
import           System.Posix.Foreign           ( oExcl )
import "unix"    System.Posix.IO.ByteString
                                         hiding ( openFd )
import           System.Posix.Process           ( ProcessStatus(..) )
import           System.Posix.Types
import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import           Text.Regex.Posix


import qualified Control.Exception             as EX
import qualified Data.Sequence                 as Sq
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as E
import qualified System.Posix.Process.ByteString
                                               as SPPB
import           Streamly.External.Posix.DirStream
import qualified Streamly.Prelude              as S
import qualified Text.Megaparsec               as MP
import qualified Data.ByteString               as BS
import qualified "unix-bytestring" System.Posix.IO.ByteString
                                               as SPIB



data ProcessError = NonZeroExit Int ByteString [ByteString]
                  | PTerminated ByteString [ByteString]
                  | PStopped ByteString [ByteString]
                  | NoSuchPid ByteString [ByteString]
                  deriving Int -> ProcessError -> ShowS
[ProcessError] -> ShowS
ProcessError -> String
(Int -> ProcessError -> ShowS)
-> (ProcessError -> String)
-> ([ProcessError] -> ShowS)
-> Show ProcessError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessError] -> ShowS
$cshowList :: [ProcessError] -> ShowS
show :: ProcessError -> String
$cshow :: ProcessError -> String
showsPrec :: Int -> ProcessError -> ShowS
$cshowsPrec :: Int -> ProcessError -> ShowS
Show

instance Pretty ProcessError where
  pPrint :: ProcessError -> Doc
pPrint (NonZeroExit Int
e ByteString
exe [ByteString]
args) =
    String -> Doc
text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} failed with exit code #{e}.|]
  pPrint (PTerminated ByteString
exe [ByteString]
args) =
    String -> Doc
text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} terminated.|]
  pPrint (PStopped ByteString
exe [ByteString]
args) =
    String -> Doc
text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} stopped.|]
  pPrint (NoSuchPid ByteString
exe [ByteString]
args) =
    String -> Doc
text [i|Could not find PID for process running "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args}.|]

data CapturedProcess = CapturedProcess
  { CapturedProcess -> ExitCode
_exitCode :: ExitCode
  , CapturedProcess -> ByteString
_stdOut   :: ByteString
  , CapturedProcess -> ByteString
_stdErr   :: ByteString
  }
  deriving (CapturedProcess -> CapturedProcess -> Bool
(CapturedProcess -> CapturedProcess -> Bool)
-> (CapturedProcess -> CapturedProcess -> Bool)
-> Eq CapturedProcess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapturedProcess -> CapturedProcess -> Bool
$c/= :: CapturedProcess -> CapturedProcess -> Bool
== :: CapturedProcess -> CapturedProcess -> Bool
$c== :: CapturedProcess -> CapturedProcess -> Bool
Eq, Int -> CapturedProcess -> ShowS
[CapturedProcess] -> ShowS
CapturedProcess -> String
(Int -> CapturedProcess -> ShowS)
-> (CapturedProcess -> String)
-> ([CapturedProcess] -> ShowS)
-> Show CapturedProcess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapturedProcess] -> ShowS
$cshowList :: [CapturedProcess] -> ShowS
show :: CapturedProcess -> String
$cshow :: CapturedProcess -> String
showsPrec :: Int -> CapturedProcess -> ShowS
$cshowsPrec :: Int -> CapturedProcess -> ShowS
Show)

makeLenses ''CapturedProcess


-- | Find the given executable by searching all *absolute* PATH components.
-- Relative paths in PATH are ignored.
--
-- This shouldn't throw IO exceptions, unless getting the environment variable
-- PATH does.
findExecutable :: Path Rel -> IO (Maybe (Path Abs))
findExecutable :: Path Rel -> IO (Maybe (Path Abs))
findExecutable Path Rel
ex = do
  [Path Abs]
sPaths <- ([ByteString] -> [Path Abs]) -> IO [ByteString] -> IO [Path Abs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe (Path Abs)] -> [Path Abs]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs)] -> [Path Abs])
-> ([ByteString] -> [Maybe (Path Abs)])
-> [ByteString]
-> [Path Abs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Path Abs))
-> [ByteString] -> [Maybe (Path Abs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs) IO [ByteString]
getSearchPath
  -- We don't want exceptions to mess up our result. If we can't
  -- figure out if a file exists, then treat it as a negative result.
  [IO (Maybe (Path Abs))] -> IO (Maybe (Path Abs))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([IO (Maybe (Path Abs))] -> IO (Maybe (Path Abs)))
-> [IO (Maybe (Path Abs))] -> IO (Maybe (Path Abs))
forall a b. (a -> b) -> a -> b
$ (Path Abs -> IO (Maybe (Path Abs)))
-> [Path Abs] -> [IO (Maybe (Path Abs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ((IOException -> IO (Maybe (Path Abs)))
-> IO (Maybe (Path Abs)) -> IO (Maybe (Path Abs))
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Maybe (Path Abs) -> IO (Maybe (Path Abs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs)
forall a. Maybe a
Nothing)
      -- asum for short-circuiting behavior
      (IO (Maybe (Path Abs)) -> IO (Maybe (Path Abs)))
-> (Path Abs -> IO (Maybe (Path Abs)))
-> Path Abs
-> IO (Maybe (Path Abs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Path Abs
s' -> (Path Abs -> IO Bool
forall b. Path b -> IO Bool
isExecutable (Path Abs
s' Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ex) IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard) IO () -> Maybe (Path Abs) -> IO (Maybe (Path Abs))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just (Path Abs
s' Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ex))
    )
    [Path Abs]
sPaths


-- | Execute the given command and collect the stdout, stderr and the exit code.
-- The command is run in a subprocess.
executeOut :: Path b            -- ^ command as filename, e.g. 'ls'
           -> [ByteString]      -- ^ arguments to the command
           -> Maybe (Path Abs)  -- ^ chdir to this path
           -> IO CapturedProcess
executeOut :: Path b -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
executeOut Path b
path [ByteString]
args Maybe (Path Abs)
chdir = IO Any -> IO CapturedProcess
forall a. IO a -> IO CapturedProcess
captureOutStreams (IO Any -> IO CapturedProcess) -> IO Any -> IO CapturedProcess
forall a b. (a -> b) -> a -> b
$ do
  IO () -> (Path Abs -> IO ()) -> Maybe (Path Abs) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ByteString -> IO ()
changeWorkingDirectory (ByteString -> IO ())
-> (Path Abs -> ByteString) -> Path Abs -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath) Maybe (Path Abs)
chdir
  ByteString
-> Bool
-> [ByteString]
-> Maybe [(ByteString, ByteString)]
-> IO Any
forall a.
ByteString
-> Bool -> [ByteString] -> Maybe [(ByteString, ByteString)] -> IO a
SPPB.executeFile (Path b -> ByteString
forall b. Path b -> ByteString
toFilePath Path b
path) Bool
True [ByteString]
args Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing


execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
           => ByteString       -- ^ thing to execute
           -> Bool             -- ^ whether to search PATH for the thing
           -> [ByteString]     -- ^ args for the thing
           -> Path Rel         -- ^ log filename
           -> Maybe (Path Abs) -- ^ optionally chdir into this
           -> Maybe [(ByteString, ByteString)] -- ^ optional environment
           -> m (Either ProcessError ())
execLogged :: ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged ByteString
exe Bool
spath [ByteString]
args Path Rel
lfile Maybe (Path Abs)
chdir Maybe [(ByteString, ByteString)]
env = do
  AppState { settings :: AppState -> Settings
settings = Settings {Bool
Downloader
KeepDirs
URLSource
urlSource :: Settings -> URLSource
verbose :: Settings -> Bool
downloader :: Settings -> Downloader
keepDirs :: Settings -> KeepDirs
noVerify :: Settings -> Bool
cache :: Settings -> Bool
urlSource :: URLSource
verbose :: Bool
downloader :: Downloader
keepDirs :: KeepDirs
noVerify :: Bool
cache :: Bool
..}, dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  Path Abs
logfile       <- (Path Abs
logsDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</>) (Path Rel -> Path Abs) -> m (Path Rel) -> m (Path Abs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
lfile ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".log")
  IO (Either ProcessError ()) -> m (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ()) -> m (Either ProcessError ()))
-> IO (Either ProcessError ()) -> m (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ IO Fd
-> (Fd -> IO ())
-> (Fd -> IO (Either ProcessError ()))
-> IO (Either ProcessError ())
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (ByteString -> FileMode -> IO Fd
createFile (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
logfile) FileMode
newFilePerms)
                   Fd -> IO ()
closeFd
                   (Bool -> Fd -> IO (Either ProcessError ())
action Bool
verbose)
 where
  action :: Bool -> Fd -> IO (Either ProcessError ())
action Bool
verbose Fd
fd = do
    ((Fd, Fd) -> IO (Either ProcessError ()))
-> IO (Either ProcessError ())
forall b. ((Fd, Fd) -> IO b) -> IO b
actionWithPipes (((Fd, Fd) -> IO (Either ProcessError ()))
 -> IO (Either ProcessError ()))
-> ((Fd, Fd) -> IO (Either ProcessError ()))
-> IO (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ \(Fd
stdoutRead, Fd
stdoutWrite) -> do
      -- start the thread that logs to stdout
      MVar Bool
pState <- IO (MVar Bool)
forall a. IO (MVar a)
newEmptyMVar
      MVar ()
done   <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
      IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
        (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO
        (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
EX.handle (\(IOException
_ :: IOException) -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
EX.finally
            (if Bool
verbose
              then Fd -> Fd -> IO ()
tee Fd
fd Fd
stdoutRead
              else Fd -> Fd -> Int -> MVar Bool -> IO ()
printToRegion Fd
fd Fd
stdoutRead Int
6 MVar Bool
pState
            )
            (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
done ())

      -- fork the subprocess
      ProcessID
pid <- IO () -> IO ProcessID
SPPB.forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
        IO Fd -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Fd -> IO ()) -> IO Fd -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IO Fd
dupTo Fd
stdoutWrite Fd
stdOutput
        IO Fd -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Fd -> IO ()) -> IO Fd -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IO Fd
dupTo Fd
stdoutWrite Fd
stdError
        Fd -> IO ()
closeFd Fd
stdoutRead
        Fd -> IO ()
closeFd Fd
stdoutWrite

        -- execute the action
        IO () -> (Path Abs -> IO ()) -> Maybe (Path Abs) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ByteString -> IO ()
changeWorkingDirectory (ByteString -> IO ())
-> (Path Abs -> ByteString) -> Path Abs -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath) Maybe (Path Abs)
chdir
        IO Any -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Any -> IO ()) -> IO Any -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Maybe [(ByteString, ByteString)]
-> IO Any
forall a.
ByteString
-> Bool -> [ByteString] -> Maybe [(ByteString, ByteString)] -> IO a
SPPB.executeFile ByteString
exe Bool
spath [ByteString]
args Maybe [(ByteString, ByteString)]
env

      Fd -> IO ()
closeFd Fd
stdoutWrite

      -- wait for the subprocess to finish
      Either ProcessError ()
e <- ByteString
-> [ByteString] -> Maybe ProcessStatus -> Either ProcessError ()
toProcessError ByteString
exe [ByteString]
args (Maybe ProcessStatus -> Either ProcessError ())
-> IO (Maybe ProcessStatus) -> IO (Either ProcessError ())
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
SPPB.getProcessStatus Bool
True Bool
True ProcessID
pid
      MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
pState ((ProcessError -> Bool)
-> (() -> Bool) -> Either ProcessError () -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ProcessError -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True) Either ProcessError ()
e)

      IO (Either () ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either () ()) -> IO ()) -> IO (Either () ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO (Either () ())
forall a b. IO a -> IO b -> IO (Either a b)
race (MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
done) (Int -> IO ()
threadDelay (Int
1000000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3))
      Fd -> IO ()
closeFd Fd
stdoutRead

      Either ProcessError () -> IO (Either ProcessError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ProcessError ()
e

  tee :: Fd -> Fd -> IO ()
  tee :: Fd -> Fd -> IO ()
tee Fd
fileFd Fd
fdIn = (ByteString -> IO ()) -> Fd -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
(ByteString -> m a) -> Fd -> m ()
readTilEOF ByteString -> IO ()
lineAction Fd
fdIn

   where
    lineAction :: ByteString -> IO ()
    lineAction :: ByteString -> IO ()
lineAction ByteString
bs' = do
      IO ByteCount -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteCount -> IO ()) -> IO ByteCount -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> ByteString -> IO ByteCount
SPIB.fdWrite Fd
fileFd (ByteString
bs' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")
      IO ByteCount -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteCount -> IO ()) -> IO ByteCount -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> ByteString -> IO ByteCount
SPIB.fdWrite Fd
stdOutput (ByteString
bs' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")

  -- Reads fdIn and logs the output in a continous scrolling area
  -- of 'size' terminal lines. Also writes to a log file.
  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
printToRegion Fd
fileFd Fd
fdIn Int
size MVar Bool
pState = do
    IO ((), Seq ByteString) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), Seq ByteString) -> IO ())
-> IO ((), Seq ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ((), Seq ByteString) -> IO ((), Seq ByteString)
forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
displayConsoleRegions (IO ((), Seq ByteString) -> IO ((), Seq ByteString))
-> IO ((), Seq ByteString) -> IO ((), Seq ByteString)
forall a b. (a -> b) -> a -> b
$ do
      Seq ConsoleRegion
rs <-
        IO (Seq ConsoleRegion) -> IO (Seq ConsoleRegion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO (Seq ConsoleRegion) -> IO (Seq ConsoleRegion))
-> (RegionLayout -> IO (Seq ConsoleRegion))
-> RegionLayout
-> IO (Seq ConsoleRegion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ConsoleRegion] -> Seq ConsoleRegion)
-> IO [ConsoleRegion] -> IO (Seq ConsoleRegion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ConsoleRegion] -> Seq ConsoleRegion
forall a. [a] -> Seq a
Sq.fromList
        (IO [ConsoleRegion] -> IO (Seq ConsoleRegion))
-> (RegionLayout -> IO [ConsoleRegion])
-> RegionLayout
-> IO (Seq ConsoleRegion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO ConsoleRegion] -> IO [ConsoleRegion]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        ([IO ConsoleRegion] -> IO [ConsoleRegion])
-> (RegionLayout -> [IO ConsoleRegion])
-> RegionLayout
-> IO [ConsoleRegion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ConsoleRegion -> [IO ConsoleRegion]
forall a. Int -> a -> [a]
replicate Int
size
        (IO ConsoleRegion -> [IO ConsoleRegion])
-> (RegionLayout -> IO ConsoleRegion)
-> RegionLayout
-> [IO ConsoleRegion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionLayout -> IO ConsoleRegion
forall (m :: * -> *).
LiftRegion m =>
RegionLayout -> m ConsoleRegion
openConsoleRegion
        (RegionLayout -> IO (Seq ConsoleRegion))
-> RegionLayout -> IO (Seq ConsoleRegion)
forall a b. (a -> b) -> a -> b
$ RegionLayout
Linear
      (StateT (Seq ByteString) IO ()
 -> Seq ByteString -> IO ((), Seq ByteString))
-> Seq ByteString
-> StateT (Seq ByteString) IO ()
-> IO ((), Seq ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Seq ByteString) IO ()
-> Seq ByteString -> IO ((), Seq ByteString)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Seq ByteString
forall a. Monoid a => a
mempty
        (StateT (Seq ByteString) IO () -> IO ((), Seq ByteString))
-> StateT (Seq ByteString) IO () -> IO ((), Seq ByteString)
forall a b. (a -> b) -> a -> b
$ (SomeException -> StateT (Seq ByteString) IO ())
-> StateT (Seq ByteString) IO () -> StateT (Seq ByteString) IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
            (\(SomeException
ex :: SomeException) -> do
              Bool
ps <- IO Bool -> StateT (Seq ByteString) IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT (Seq ByteString) IO Bool)
-> IO Bool -> StateT (Seq ByteString) IO Bool
forall a b. (a -> b) -> a -> b
$ MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
pState
              Bool
-> StateT (Seq ByteString) IO () -> StateT (Seq ByteString) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ps (Seq ConsoleRegion
-> (ConsoleRegion -> StateT (Seq ByteString) IO ())
-> StateT (Seq ByteString) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Seq ConsoleRegion
rs (IO () -> StateT (Seq ByteString) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (Seq ByteString) IO ())
-> (ConsoleRegion -> IO ())
-> ConsoleRegion
-> StateT (Seq ByteString) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsoleRegion -> IO ()
forall (m :: * -> *). LiftRegion m => ConsoleRegion -> m ()
closeConsoleRegion))
              SomeException -> StateT (Seq ByteString) IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw SomeException
ex
            )
        (StateT (Seq ByteString) IO () -> StateT (Seq ByteString) IO ())
-> StateT (Seq ByteString) IO () -> StateT (Seq ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> StateT (Seq ByteString) IO ())
-> Fd -> StateT (Seq ByteString) IO ()
forall (m :: * -> *) a.
MonadIO m =>
(ByteString -> m a) -> Fd -> m ()
readTilEOF (Seq ConsoleRegion -> ByteString -> StateT (Seq ByteString) IO ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
Seq ConsoleRegion -> ByteString -> StateT (Seq ByteString) m ()
lineAction Seq ConsoleRegion
rs) Fd
fdIn

   where
    -- action to perform line by line
    -- TODO: do this with vty for efficiency
    lineAction :: (MonadMask m, MonadIO m)
               => Seq ConsoleRegion
               -> ByteString
               -> StateT (Seq ByteString) m ()
    lineAction :: Seq ConsoleRegion -> ByteString -> StateT (Seq ByteString) m ()
lineAction Seq ConsoleRegion
rs = \ByteString
bs' -> do
      StateT (Seq ByteString) m ByteCount -> StateT (Seq ByteString) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT (Seq ByteString) m ByteCount
 -> StateT (Seq ByteString) m ())
-> StateT (Seq ByteString) m ByteCount
-> StateT (Seq ByteString) m ()
forall a b. (a -> b) -> a -> b
$ IO ByteCount -> StateT (Seq ByteString) m ByteCount
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteCount -> StateT (Seq ByteString) m ByteCount)
-> IO ByteCount -> StateT (Seq ByteString) m ByteCount
forall a b. (a -> b) -> a -> b
$ Fd -> ByteString -> IO ByteCount
SPIB.fdWrite Fd
fileFd (ByteString
bs' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")
      (Seq ByteString -> Seq ByteString) -> StateT (Seq ByteString) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (ByteString -> Seq ByteString -> Seq ByteString
forall a. a -> Seq a -> Seq a
swapRegs ByteString
bs')
      Seq ByteString
regs <- StateT (Seq ByteString) m (Seq ByteString)
forall (m :: * -> *) s. Monad m => StateT s m s
get
      IO () -> StateT (Seq ByteString) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (Seq ByteString) m ())
-> IO () -> StateT (Seq ByteString) m ()
forall a b. (a -> b) -> a -> b
$ Seq (ByteString, ConsoleRegion)
-> ((ByteString, ConsoleRegion) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Seq ByteString
-> Seq ConsoleRegion -> Seq (ByteString, ConsoleRegion)
forall a b. Seq a -> Seq b -> Seq (a, b)
Sq.zip Seq ByteString
regs Seq ConsoleRegion
rs) (((ByteString, ConsoleRegion) -> IO ()) -> IO ())
-> ((ByteString, ConsoleRegion) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ByteString
bs, ConsoleRegion
r) -> ConsoleRegion -> STM Text -> IO ()
forall v (m :: * -> *).
(ToRegionContent v, LiftRegion m) =>
ConsoleRegion -> v -> m ()
setConsoleRegion ConsoleRegion
r (STM Text -> IO ()) -> STM Text -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Int
w <- STM Int
consoleWidth
        Text -> STM Text
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Text -> STM Text)
-> (ByteString -> Text) -> ByteString -> STM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
          (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> ShowS
forall a. Pretty a => Color -> a -> a
color Color
Blue
          ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
          (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe
          (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
trim Int
w
          (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ByteString
b -> ByteString
"[ " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
lfile ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" ] " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b)
          (ByteString -> STM Text) -> ByteString -> STM Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs

    swapRegs :: a -> Seq a -> Seq a
    swapRegs :: a -> Seq a -> Seq a
swapRegs a
bs = \Seq a
regs -> if
      | Seq a -> Int
forall a. Seq a -> Int
Sq.length Seq a
regs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size -> Seq a
regs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
bs
      | Bool
otherwise             -> Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Sq.drop Int
1 Seq a
regs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
bs

    -- trim output line to terminal width
    trim :: Int -> ByteString -> ByteString
    trim :: Int -> ByteString -> ByteString
trim Int
w = \ByteString
bs -> if
      | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 -> Int -> ByteString -> ByteString
BS.take (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"..."
      | Bool
otherwise                 -> ByteString
bs

  -- Consecutively read from Fd in 512 chunks until we hit
  -- newline or EOF.
  readLine :: MonadIO m
           => Fd          -- ^ input file descriptor
           -> ByteString  -- ^ rest buffer (read across newline)
           -> m (ByteString, ByteString, Bool) -- ^ (full line, rest, eof)
  readLine :: Fd -> ByteString -> m (ByteString, ByteString, Bool)
readLine Fd
fd = ByteString -> m (ByteString, ByteString, Bool)
forall (m :: * -> *).
MonadIO m =>
ByteString -> m (ByteString, ByteString, Bool)
go
   where
    go :: ByteString -> m (ByteString, ByteString, Bool)
go ByteString
inBs = do
      -- if buffer is not empty, process it first
      Maybe ByteString
mbs <- if ByteString -> Int
BS.length ByteString
inBs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
               -- otherwise attempt read
               then IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                    (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (IOException -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if IOException -> Bool
isEOFError IOException
e then Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing else IOException -> IO (Maybe ByteString)
forall a. IOException -> IO a
ioError IOException
e)
                    (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
                    (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Fd -> ByteCount -> IO ByteString
SPIB.fdRead Fd
fd ByteCount
512
               else Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> Maybe ByteString -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
inBs
      case Maybe ByteString
mbs of
        Maybe ByteString
Nothing -> (ByteString, ByteString, Bool) -> m (ByteString, ByteString, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
"", ByteString
"", Bool
True)
        Just ByteString
bs -> do
          -- split on newline
          let (ByteString
line, ByteString
rest) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
_lf) ByteString
bs
          if
            | ByteString -> Int
BS.length ByteString
rest Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 -> (ByteString, ByteString, Bool) -> m (ByteString, ByteString, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
line, ByteString -> ByteString
BS.tail ByteString
rest, Bool
False)
            -- if rest is empty, then there was no newline, process further
            | Bool
otherwise           -> (\(ByteString
l, ByteString
r, Bool
b) -> (ByteString
line ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
l, ByteString
r, Bool
b)) ((ByteString, ByteString, Bool) -> (ByteString, ByteString, Bool))
-> m (ByteString, ByteString, Bool)
-> m (ByteString, ByteString, Bool)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ByteString -> m (ByteString, ByteString, Bool)
go ByteString
forall a. Monoid a => a
mempty

  readTilEOF :: MonadIO m => (ByteString -> m a) -> Fd -> m ()
  readTilEOF :: (ByteString -> m a) -> Fd -> m ()
readTilEOF ~ByteString -> m a
action' Fd
fd' = ByteString -> m ()
forall b. ByteString -> m b
go ByteString
forall a. Monoid a => a
mempty
   where
    go :: ByteString -> m b
go ByteString
bs' = do
      (ByteString
bs, ByteString
rest, Bool
eof) <- Fd -> ByteString -> m (ByteString, ByteString, Bool)
forall (m :: * -> *).
MonadIO m =>
Fd -> ByteString -> m (ByteString, ByteString, Bool)
readLine Fd
fd' ByteString
bs'
      if Bool
eof
         then IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ IOException -> IO b
forall a. IOException -> IO a
ioError (IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
eofErrorType String
"" Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
         else m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> m a
action' ByteString
bs) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> m b
go ByteString
rest


-- | Capture the stdout and stderr of the given action, which
-- is run in a subprocess. Stdin is closed. You might want to
-- 'race' this to make sure it terminates.
captureOutStreams :: IO a
                     -- ^ the action to execute in a subprocess
                  -> IO CapturedProcess
captureOutStreams :: IO a -> IO CapturedProcess
captureOutStreams IO a
action = do
  ((Fd, Fd) -> IO CapturedProcess) -> IO CapturedProcess
forall b. ((Fd, Fd) -> IO b) -> IO b
actionWithPipes (((Fd, Fd) -> IO CapturedProcess) -> IO CapturedProcess)
-> ((Fd, Fd) -> IO CapturedProcess) -> IO CapturedProcess
forall a b. (a -> b) -> a -> b
$ \(Fd
parentStdoutRead, Fd
childStdoutWrite) ->
    ((Fd, Fd) -> IO CapturedProcess) -> IO CapturedProcess
forall b. ((Fd, Fd) -> IO b) -> IO b
actionWithPipes (((Fd, Fd) -> IO CapturedProcess) -> IO CapturedProcess)
-> ((Fd, Fd) -> IO CapturedProcess) -> IO CapturedProcess
forall a b. (a -> b) -> a -> b
$ \(Fd
parentStderrRead, Fd
childStderrWrite) -> do
      ProcessID
pid <- IO () -> IO ProcessID
SPPB.forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
        -- dup stdout
        IO Fd -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Fd -> IO ()) -> IO Fd -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IO Fd
dupTo Fd
childStdoutWrite Fd
stdOutput
        Fd -> IO ()
closeFd Fd
childStdoutWrite
        Fd -> IO ()
closeFd Fd
parentStdoutRead

        -- dup stderr
        IO Fd -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Fd -> IO ()) -> IO Fd -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IO Fd
dupTo Fd
childStderrWrite Fd
stdError
        Fd -> IO ()
closeFd Fd
childStderrWrite
        Fd -> IO ()
closeFd Fd
parentStderrRead

        -- execute the action
        a
a <- IO a
action
        IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall a. a -> IO a
evaluate a
a

      -- close everything we don't need
      Fd -> IO ()
closeFd Fd
childStdoutWrite
      Fd -> IO ()
closeFd Fd
childStderrWrite

      -- start thread that writes the output
      IORef ByteString
refOut <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
BS.empty
      IORef ByteString
refErr <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
BS.empty
      MVar ()
done   <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
      ThreadId
_      <-
        IO () -> IO ThreadId
forkIO
        (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
EX.handle (\(IOException
_ :: IOException) -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
EX.finally (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
done ())
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> IORef ByteString -> IORef ByteString -> IO ()
writeStds Fd
parentStdoutRead Fd
parentStderrRead IORef ByteString
refOut IORef ByteString
refErr

      Maybe ProcessStatus
status <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
SPPB.getProcessStatus Bool
True Bool
True ProcessID
pid
      IO (Either () ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either () ()) -> IO ()) -> IO (Either () ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO (Either () ())
forall a b. IO a -> IO b -> IO (Either a b)
race (MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
done) (Int -> IO ()
threadDelay (Int
1000000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3))

      case Maybe ProcessStatus
status of
        -- readFd will take care of closing the fd
        Just (SPPB.Exited ExitCode
es) -> do
          ByteString
stdout' <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
refOut
          ByteString
stderr' <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
refErr
          CapturedProcess -> IO CapturedProcess
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CapturedProcess -> IO CapturedProcess)
-> CapturedProcess -> IO CapturedProcess
forall a b. (a -> b) -> a -> b
$ CapturedProcess :: ExitCode -> ByteString -> ByteString -> CapturedProcess
CapturedProcess { _exitCode :: ExitCode
_exitCode = ExitCode
es
                                 , _stdOut :: ByteString
_stdOut   = ByteString
stdout'
                                 , _stdErr :: ByteString
_stdErr   = ByteString
stderr'
                                 }

        Maybe ProcessStatus
_ -> IOException -> IO CapturedProcess
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOException -> IO CapturedProcess)
-> IOException -> IO CapturedProcess
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError (String
"No such PID " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProcessID -> String
forall a. Show a => a -> String
show ProcessID
pid)

 where
  writeStds :: Fd -> Fd -> IORef ByteString -> IORef ByteString -> IO ()
writeStds Fd
pout Fd
perr IORef ByteString
rout IORef ByteString
rerr = do
    MVar ()
doneOut <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO
      (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
eofErrorType
      (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
EX.finally (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneOut ())
      (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO ()) -> Fd -> IO ()
forall a b. (ByteString -> IO a) -> Fd -> IO b
readTilEOF (\ByteString
x -> IORef ByteString -> (ByteString -> ByteString) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef ByteString
rout (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x)) Fd
pout
    MVar ()
doneErr <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
    IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO
      (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
eofErrorType
      (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
EX.finally (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
doneErr ())
      (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO ()) -> Fd -> IO ()
forall a b. (ByteString -> IO a) -> Fd -> IO b
readTilEOF (\ByteString
x -> IORef ByteString -> (ByteString -> ByteString) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef ByteString
rerr (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x)) Fd
perr
    MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
doneOut
    MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
doneErr

  readTilEOF :: (ByteString -> IO a) -> Fd -> IO b
readTilEOF ~ByteString -> IO a
action' Fd
fd' = do
    ByteString
bs <- Fd -> ByteCount -> IO ByteString
SPIB.fdRead Fd
fd' ByteCount
512
    IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO a
action' ByteString
bs
    (ByteString -> IO a) -> Fd -> IO b
readTilEOF ByteString -> IO a
action' Fd
fd'


actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
actionWithPipes (Fd, Fd) -> IO b
a =
  IO (Fd, Fd)
createPipe IO (Fd, Fd) -> ((Fd, Fd) -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Fd
p1, Fd
p2) -> (IO b -> IO () -> IO b) -> IO () -> IO b -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO b -> IO () -> IO b
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
finally ([Fd] -> IO ()
cleanup [Fd
p1, Fd
p2]) (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ (Fd, Fd) -> IO b
a (Fd
p1, Fd
p2)

cleanup :: [Fd] -> IO ()
cleanup :: [Fd] -> IO ()
cleanup [Fd]
fds = [Fd] -> (Fd -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Fd]
fds ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> (IOException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Fd -> IO ()
closeFd Fd
fd



-- | Create a new regular file in write-only mode. The file must not exist.
createRegularFileFd :: FileMode -> Path b -> IO Fd
createRegularFileFd :: FileMode -> Path b -> IO Fd
createRegularFileFd FileMode
fm Path b
dest =
  ByteString -> OpenMode -> [Flags] -> Maybe FileMode -> IO Fd
FD.openFd (Path b -> ByteString
forall b. Path b -> ByteString
toFilePath Path b
dest) OpenMode
WriteOnly [Flags
oExcl] (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
fm)


-- | Thin wrapper around `executeFile`.
exec :: ByteString       -- ^ thing to execute
     -> Bool             -- ^ whether to search PATH for the thing
     -> [ByteString]     -- ^ args for the thing
     -> Maybe (Path Abs) -- ^ optionally chdir into this
     -> Maybe [(ByteString, ByteString)] -- ^ optional environment
     -> IO (Either ProcessError ())
exec :: ByteString
-> Bool
-> [ByteString]
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> IO (Either ProcessError ())
exec ByteString
exe Bool
spath [ByteString]
args Maybe (Path Abs)
chdir Maybe [(ByteString, ByteString)]
env = do
  ProcessID
pid <- IO () -> IO ProcessID
SPPB.forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
    IO () -> (Path Abs -> IO ()) -> Maybe (Path Abs) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ByteString -> IO ()
changeWorkingDirectory (ByteString -> IO ())
-> (Path Abs -> ByteString) -> Path Abs -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath) Maybe (Path Abs)
chdir
    ByteString
-> Bool
-> [ByteString]
-> Maybe [(ByteString, ByteString)]
-> IO ()
forall a.
ByteString
-> Bool -> [ByteString] -> Maybe [(ByteString, ByteString)] -> IO a
SPPB.executeFile ByteString
exe Bool
spath [ByteString]
args Maybe [(ByteString, ByteString)]
env

  (Maybe ProcessStatus -> Either ProcessError ())
-> IO (Maybe ProcessStatus) -> IO (Either ProcessError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString
-> [ByteString] -> Maybe ProcessStatus -> Either ProcessError ()
toProcessError ByteString
exe [ByteString]
args) (IO (Maybe ProcessStatus) -> IO (Either ProcessError ()))
-> IO (Maybe ProcessStatus) -> IO (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
SPPB.getProcessStatus Bool
True Bool
True ProcessID
pid


toProcessError :: ByteString
               -> [ByteString]
               -> Maybe ProcessStatus
               -> Either ProcessError ()
toProcessError :: ByteString
-> [ByteString] -> Maybe ProcessStatus -> Either ProcessError ()
toProcessError ByteString
exe [ByteString]
args Maybe ProcessStatus
mps = case Maybe ProcessStatus
mps of
  Just (SPPB.Exited (ExitFailure Int
xi)) -> ProcessError -> Either ProcessError ()
forall a b. a -> Either a b
Left (ProcessError -> Either ProcessError ())
-> ProcessError -> Either ProcessError ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString] -> ProcessError
NonZeroExit Int
xi ByteString
exe [ByteString]
args
  Just (SPPB.Exited ExitCode
ExitSuccess    ) -> () -> Either ProcessError ()
forall a b. b -> Either a b
Right ()
  Just (Terminated Signal
_ Bool
_             ) -> ProcessError -> Either ProcessError ()
forall a b. a -> Either a b
Left (ProcessError -> Either ProcessError ())
-> ProcessError -> Either ProcessError ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ProcessError
PTerminated ByteString
exe [ByteString]
args
  Just (Stopped Signal
_                  ) -> ProcessError -> Either ProcessError ()
forall a b. a -> Either a b
Left (ProcessError -> Either ProcessError ())
-> ProcessError -> Either ProcessError ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ProcessError
PStopped ByteString
exe [ByteString]
args
  Maybe ProcessStatus
Nothing                            -> ProcessError -> Either ProcessError ()
forall a b. a -> Either a b
Left (ProcessError -> Either ProcessError ())
-> ProcessError -> Either ProcessError ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ProcessError
NoSuchPid ByteString
exe [ByteString]
args


-- | Search for a file in the search paths.
--
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
searchPath :: [Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath :: [Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath [Path Abs]
paths Path Rel
needle = [Path Abs] -> IO (Maybe (Path Abs))
forall b. [Path b] -> IO (Maybe (Path b))
go [Path Abs]
paths
 where
  go :: [Path b] -> IO (Maybe (Path b))
go [] = Maybe (Path b) -> IO (Maybe (Path b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path b)
forall a. Maybe a
Nothing
  go (Path b
x : [Path b]
xs) =
    [IOErrorType]
-> IO (Maybe (Path b))
-> IO (Maybe (Path b))
-> IO (Maybe (Path b))
forall a. [IOErrorType] -> IO a -> IO a -> IO a
hideErrorDefM [IOErrorType
InappropriateType, IOErrorType
PermissionDenied, IOErrorType
NoSuchThing] ([Path b] -> IO (Maybe (Path b))
go [Path b]
xs)
      (IO (Maybe (Path b)) -> IO (Maybe (Path b)))
-> IO (Maybe (Path b)) -> IO (Maybe (Path b))
forall a b. (a -> b) -> a -> b
$ do
          DirStream
dirStream <- ByteString -> IO DirStream
openDirStream (Path b -> ByteString
forall b. Path b -> ByteString
toFilePath Path b
x)
          ((DirType, ByteString) -> IO Bool)
-> SerialT IO (DirType, ByteString)
-> IO (Maybe (DirType, ByteString))
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> SerialT m a -> m (Maybe a)
S.findM (\(DirType
_, ByteString
p) -> Path b -> ByteString -> IO Bool
forall b. Path b -> ByteString -> IO Bool
isMatch Path b
x ByteString
p) (DirStream -> SerialT IO (DirType, ByteString)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
DirStream -> SerialT m (DirType, ByteString)
dirContentsStream DirStream
dirStream)
            IO (Maybe (DirType, ByteString))
-> (Maybe (DirType, ByteString) -> IO (Maybe (Path b)))
-> IO (Maybe (Path b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Just (DirType, ByteString)
_  -> Maybe (Path b) -> IO (Maybe (Path b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Path b) -> IO (Maybe (Path b)))
-> Maybe (Path b) -> IO (Maybe (Path b))
forall a b. (a -> b) -> a -> b
$ Path b -> Maybe (Path b)
forall a. a -> Maybe a
Just (Path b
x Path b -> Path Rel -> Path b
forall b. Path b -> Path Rel -> Path b
</> Path Rel
needle)
                  Maybe (DirType, ByteString)
Nothing -> [Path b] -> IO (Maybe (Path b))
go [Path b]
xs
  isMatch :: Path b -> ByteString -> IO Bool
isMatch Path b
basedir ByteString
p = do
    if ByteString
p ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
needle
      then Path b -> IO Bool
forall b. Path b -> IO Bool
isExecutable (Path b
basedir Path b -> Path Rel -> Path b
forall b. Path b -> Path Rel -> Path b
</> Path Rel
needle)
      else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Check wether a binary is shadowed by another one that comes before
-- it in PATH. Returns the path to said binary, if any.
isShadowed :: Path Abs -> IO (Maybe (Path Abs))
isShadowed :: Path Abs -> IO (Maybe (Path Abs))
isShadowed Path Abs
p = do
  let dir :: Path Abs
dir = Path Abs -> Path Abs
dirname Path Abs
p
  Path Rel
fn <- Path Abs -> IO (Path Rel)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Rel)
basename Path Abs
p
  [Path Abs]
spaths <- [Maybe (Path Abs)] -> [Path Abs]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs)] -> [Path Abs])
-> ([ByteString] -> [Maybe (Path Abs)])
-> [ByteString]
-> [Path Abs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Path Abs))
-> [ByteString] -> [Maybe (Path Abs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ([ByteString] -> [Path Abs]) -> IO [ByteString] -> IO [Path Abs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getSearchPath
  if Path Abs
dir Path Abs -> [Path Abs] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path Abs]
spaths
  then do
    let shadowPaths :: [Path Abs]
shadowPaths = (Path Abs -> Bool) -> [Path Abs] -> [Path Abs]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Path Abs -> Path Abs -> Bool
forall a. Eq a => a -> a -> Bool
/= Path Abs
dir) [Path Abs]
spaths
    [Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath [Path Abs]
shadowPaths Path Rel
fn
  else Maybe (Path Abs) -> IO (Maybe (Path Abs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs)
forall a. Maybe a
Nothing


-- | Check whether the binary is in PATH. This returns only `True`
-- if the directory containing the binary is part of PATH.
isInPath :: Path Abs -> IO Bool
isInPath :: Path Abs -> IO Bool
isInPath Path Abs
p = do
  let dir :: Path Abs
dir = Path Abs -> Path Abs
dirname Path Abs
p
  Path Rel
fn <- Path Abs -> IO (Path Rel)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Rel)
basename Path Abs
p
  [Path Abs]
spaths <- [Maybe (Path Abs)] -> [Path Abs]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs)] -> [Path Abs])
-> ([ByteString] -> [Maybe (Path Abs)])
-> [ByteString]
-> [Path Abs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Path Abs))
-> [ByteString] -> [Maybe (Path Abs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ([ByteString] -> [Path Abs]) -> IO [ByteString] -> IO [Path Abs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getSearchPath
  if Path Abs
dir Path Abs -> [Path Abs] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path Abs]
spaths
  then Maybe (Path Abs) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Path Abs) -> Bool) -> IO (Maybe (Path Abs)) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath [Path Abs
dir] Path Rel
fn
  else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


findFiles :: Path Abs -> Regex -> IO [Path Rel]
findFiles :: Path Abs -> Regex -> IO [Path Rel]
findFiles Path Abs
path Regex
regex = do
  DirStream
dirStream <- ByteString -> IO DirStream
openDirStream (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
path)
  [ByteString]
f         <-
    (([(DirType, ByteString)] -> [ByteString])
-> IO [(DirType, ByteString)] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(DirType, ByteString)] -> [ByteString])
 -> IO [(DirType, ByteString)] -> IO [ByteString])
-> (((DirType, ByteString) -> ByteString)
    -> [(DirType, ByteString)] -> [ByteString])
-> ((DirType, ByteString) -> ByteString)
-> IO [(DirType, ByteString)]
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DirType, ByteString) -> ByteString)
-> [(DirType, ByteString)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (DirType, ByteString) -> ByteString
forall a b. (a, b) -> b
snd
    (IO [(DirType, ByteString)] -> IO [ByteString])
-> (SerialT IO (DirType, ByteString) -> IO [(DirType, ByteString)])
-> SerialT IO (DirType, ByteString)
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialT IO (DirType, ByteString) -> IO [(DirType, ByteString)]
forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList
    (SerialT IO (DirType, ByteString) -> IO [(DirType, ByteString)])
-> (SerialT IO (DirType, ByteString)
    -> SerialT IO (DirType, ByteString))
-> SerialT IO (DirType, ByteString)
-> IO [(DirType, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DirType, ByteString) -> Bool)
-> SerialT IO (DirType, ByteString)
-> SerialT IO (DirType, ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
(a -> Bool) -> t m a -> t m a
S.filter (\(DirType
_, ByteString
p) -> Regex -> ByteString -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
regex ByteString
p)
    (SerialT IO (DirType, ByteString) -> IO [ByteString])
-> SerialT IO (DirType, ByteString) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ DirStream -> SerialT IO (DirType, ByteString)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
DirStream -> SerialT m (DirType, ByteString)
dirContentsStream DirStream
dirStream
  [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Rel] -> IO [Path Rel]) -> [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Path Rel]
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> [Path Rel]) -> [ByteString] -> [Path Rel]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ByteString]
f


findFiles' :: Path Abs -> MP.Parsec Void Text () -> IO [Path Rel]
findFiles' :: Path Abs -> Parsec Void Text () -> IO [Path Rel]
findFiles' Path Abs
path Parsec Void Text ()
parser = do
  DirStream
dirStream <- ByteString -> IO DirStream
openDirStream (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
path)
  [ByteString]
f         <-
    (([(DirType, ByteString)] -> [ByteString])
-> IO [(DirType, ByteString)] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(DirType, ByteString)] -> [ByteString])
 -> IO [(DirType, ByteString)] -> IO [ByteString])
-> (((DirType, ByteString) -> ByteString)
    -> [(DirType, ByteString)] -> [ByteString])
-> ((DirType, ByteString) -> ByteString)
-> IO [(DirType, ByteString)]
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DirType, ByteString) -> ByteString)
-> [(DirType, ByteString)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (DirType, ByteString) -> ByteString
forall a b. (a, b) -> b
snd
    (IO [(DirType, ByteString)] -> IO [ByteString])
-> (SerialT IO (DirType, ByteString) -> IO [(DirType, ByteString)])
-> SerialT IO (DirType, ByteString)
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialT IO (DirType, ByteString) -> IO [(DirType, ByteString)]
forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList
    (SerialT IO (DirType, ByteString) -> IO [(DirType, ByteString)])
-> (SerialT IO (DirType, ByteString)
    -> SerialT IO (DirType, ByteString))
-> SerialT IO (DirType, ByteString)
-> IO [(DirType, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DirType, ByteString) -> Bool)
-> SerialT IO (DirType, ByteString)
-> SerialT IO (DirType, ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
(a -> Bool) -> t m a -> t m a
S.filter (\(DirType
_, ByteString
p) -> case ByteString -> Either UnicodeException Text
E.decodeUtf8' ByteString
p of
                             Left UnicodeException
_ -> Bool
False
                             Right Text
p' -> Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ Parsec Void Text () -> Text -> Maybe ()
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
MP.parseMaybe Parsec Void Text ()
parser Text
p')
    (SerialT IO (DirType, ByteString) -> IO [ByteString])
-> SerialT IO (DirType, ByteString) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ DirStream -> SerialT IO (DirType, ByteString)
forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
DirStream -> SerialT m (DirType, ByteString)
dirContentsStream DirStream
dirStream
  [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Rel] -> IO [Path Rel]) -> [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Path Rel]
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> [Path Rel]) -> [ByteString] -> [Path Rel]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ByteString]
f


isBrokenSymlink :: Path Abs -> IO Bool
isBrokenSymlink :: Path Abs -> IO Bool
isBrokenSymlink Path Abs
p =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO
      (\IOException
e -> if IOException -> IOErrorType
ioeGetErrorType IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
NoSuchThing then Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else IOException -> IO Bool
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
e)
    (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
        Path Abs
_ <- Path Abs -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
canonicalizePath Path Abs
p
        Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


chmod_755 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_755 :: Path a -> m ()
chmod_755 (Path a -> ByteString
forall b. Path b -> ByteString
toFilePath -> ByteString
fp) = do
  let exe_mode :: FileMode
exe_mode =
          FileMode
nullFileMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerExecuteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerReadMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
ownerWriteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupExecuteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
groupReadMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherExecuteMode
            FileMode -> FileMode -> FileMode
`unionFileModes` FileMode
otherReadMode
  $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
pack :: String -> Text
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|chmod 755 #{fp}|]
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> FileMode -> IO ()
setFileMode ByteString
fp FileMode
exe_mode