ghcup-hs/lib/GHCup/File.hs

110 lines
3.7 KiB
Haskell

module GHCup.File where
import Data.ByteString
import qualified Data.ByteString.Lazy as L
import Data.Char
import Data.Maybe
import HPath
import HPath.IO
import Streamly.ByteString
import Streamly
import System.Posix.FilePath hiding ( (</>) )
import Data.Foldable
import Control.Monad
import Control.Exception.Safe
import Data.Functor
import System.Posix.Files.ByteString
import System.IO
import System.Posix.IO.ByteString
hiding ( openFd )
import qualified System.Posix.Process.ByteString
as SPPB
import System.Posix.Types
import qualified Streamly.Internal.Memory.ArrayStream
as AS
import qualified Streamly.FileSystem.Handle as FH
import qualified Streamly.Internal.Data.Unfold as SU
import qualified Streamly.Prelude as S
import System.Exit
import qualified Streamly.Data.Fold as FL
import Data.ByteString.Builder
import Foreign.C.Error
import GHCup.Prelude
-- |Checks whether a file is executable. Follows symlinks.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
-- - `NoSuchThing` if the file does not exist
--
-- Note: calls `access`
isExecutable :: Path b -> IO Bool
isExecutable p = fileAccess (toFilePath p) False False True
readFd :: Fd -> IO L.ByteString
readFd fd = do
handle' <- fdToHandle fd
let stream =
(S.unfold (SU.finally hClose FH.readChunks) handle')
>>= arrayToByteString
toLazyByteString <$> S.fold FL.mconcat (fmap byteString stream)
-- | Read the lines of a file into a stream. The stream holds
-- a file handle as a resource and will close it once the stream
-- terminates (either through exception or because it's drained).
readFileLines :: Path b -> IO (SerialT IO ByteString)
readFileLines p = do
stream <- readFileStream p
pure
. (>>= arrayToByteString)
. AS.splitOn (fromIntegral $ ord '\n')
. (>>= byteStringToArray)
$ stream
-- | 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 :: RelC r => Path r -> IO (Maybe (Path Abs))
findExecutable ex = do
sPaths <- fmap catMaybes . (fmap . fmap) parseAbs $ 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.
asum $ fmap (handleIO (\_ -> pure Nothing)) $ fmap
-- asum for short-circuiting behavior
(\s -> (isExecutable (s </> ex) >>= guard) $> (Just (s </> ex)))
sPaths
-- | Execute the given command and collect the stdout and the exit code.
executeOut :: Path Fn -- ^ command as filename, e.g. 'ls'
-> [ByteString] -- ^ arguments to the command
-> IO (Maybe (L.ByteString, ExitCode)) -- ^ fst of the tuple is the stdout
executeOut path args = withFnPath path $ \fp -> do
(parentRead, childWrite) <- createPipe
pid <- SPPB.forkProcess $ do
whileM_
(dupTo childWrite stdOutput)
(\r ->
getErrno >>= \e -> pure $ r == fromIntegral (-1 :: Int) && e == eINTR
)
closeFd childWrite
closeFd parentRead
closeFd stdInput
SPPB.executeFile fp True args Nothing
closeFd childWrite
SPPB.getProcessStatus True True pid >>= \case
-- readE will take care of closing the fd
Just (SPPB.Exited es) -> readFd parentRead <&> Just . (, es)
_ -> closeFd parentRead $> Nothing