ghcup-hs/lib/GHCup/File.hs

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