{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
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
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
[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)
(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
executeOut :: Path b
-> [ByteString]
-> Maybe (Path Abs)
-> 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
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> 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
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 ())
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
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
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")
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
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 :: 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
readLine :: MonadIO m
=> Fd
-> ByteString
-> m (ByteString, ByteString, Bool)
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
Maybe ByteString
mbs <- if ByteString -> Int
BS.length ByteString
inBs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
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
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)
| 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
captureOutStreams :: IO a
-> 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
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
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
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
Fd -> IO ()
closeFd Fd
childStdoutWrite
Fd -> IO ()
closeFd Fd
childStderrWrite
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
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
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)
exec :: ByteString
-> Bool
-> [ByteString]
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> 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
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
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
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