{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}

module GHCup.File where

import           Data.ByteString
import qualified Data.ByteString.Lazy          as L
import           Data.Char
import           Data.Maybe
import           Data.String.QQ
import           HPath
import           HPath.IO
import           Optics
import           Streamly.External.ByteString
import           Streamly.External.ByteString.Lazy
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.Posix.Foreign           ( oExcl )
import           System.Posix.Env.ByteString
import           System.IO
import qualified System.Posix.FilePath         as FP
import "unix"    System.Posix.IO.ByteString
                                         hiding ( openFd )
import qualified System.Posix.Process.ByteString
                                               as SPPB
import           System.Posix.Directory.ByteString
import           System.Posix.Process           ( ProcessStatus(..) )
import           System.Posix.Temp.ByteString
import           System.Posix.Types
import qualified System.Posix.User             as PU

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
import           Control.Concurrent.Async
import           Control.Concurrent
import           System.Posix.FD               as FD
import qualified Data.ByteString.UTF8          as UTF8
import           Data.ByteString.Unsafe         ( unsafeUseAsCStringLen )
import           GHC.IO.Encoding                ( getLocaleEncoding )
import           GHC.Foreign                    ( peekCStringLen )



data ProcessError = NonZeroExit Int ByteString [ByteString]
                  | PTerminated ByteString [ByteString]
                  | PStopped ByteString [ByteString]
                  | NoSuchPid ByteString [ByteString]
                  deriving Show


data CapturedProcess = CapturedProcess {
    _exitCode :: ExitCode
  , _stdOut   :: ByteString
  , _stdErr   :: ByteString
} deriving (Eq, Show)

makeLenses ''CapturedProcess


readFd :: Fd -> IO L.ByteString
readFd fd = do
  handle' <- fdToHandle fd
  fromChunksIO $ (S.unfold (SU.finallyIO hClose FH.readChunks) handle')


-- | 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
    . (fmap fromArray)
    . AS.splitOn (fromIntegral $ ord '\n')
    . (fmap toArray)
    $ 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 :: Path Rel -> 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, 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 args chdir =
  captureOutStreams $ do
   maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
   SPPB.executeFile (toFilePath path) True args Nothing


-- | 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 action =
  actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
    actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
      pid <- SPPB.forkProcess $ do
        -- dup stdout
        void $ dupTo childStdoutWrite stdOutput
        closeFd childStdoutWrite
        closeFd parentStdoutRead

        -- dup stderr
        void $ dupTo childStderrWrite stdError
        closeFd childStderrWrite
        closeFd parentStderrRead

        -- execute the action
        void $ action

      -- close everything we don't need
      closeFd childStdoutWrite
      closeFd childStderrWrite

      SPPB.getProcessStatus True True pid >>= \case
        -- readFd will take care of closing the fd
        Just (SPPB.Exited es) -> do
          stdout' <- L.toStrict <$> readFd parentStdoutRead
          stderr' <- L.toStrict <$> readFd parentStderrRead
          pure $ CapturedProcess { _exitCode = es
                                        , _stdOut   = stdout'
                                        , _stdErr   = stderr'
                                        }
        _ -> throwIO $ userError $ ("No such PID " ++ show pid)

 where
  actionWithPipes a =
    createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2)
  cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd



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


exec :: ByteString      -- ^ thing to execute
     -> [ByteString]     -- ^ args for the thing
     -> Bool             -- ^ whether to search PATH for the thing
     -> Maybe (Path Abs) -- ^ optionally chdir into this
     -> IO (Either ProcessError ())
exec exe args spath chdir = do
  pid <- SPPB.forkProcess $ do
    maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
    SPPB.executeFile exe spath args Nothing

  fmap (toProcessError exe args) $ SPPB.getProcessStatus True True pid


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


mkGhcupTmpDir :: IO (Path Abs)
mkGhcupTmpDir = do
  tmpdir <- getEnvDefault [s|TMPDIR|] [s|/tmp|]
  tmp    <- mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
  parseAbs tmp


getHomeDirectory :: IO (Path Abs)
getHomeDirectory = do
  e <- getEnv [s|HOME|]
  case e of
    Just fp -> parseAbs fp
    Nothing -> do
      h <- PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)
      parseAbs $ UTF8.fromString h -- this is a guess


-- | Convert the String to a ByteString with the current
-- system encoding.
unsafePathToString :: Path b -> IO FilePath
unsafePathToString (Path p) = do
  enc <- getLocaleEncoding
  unsafeUseAsCStringLen p (peekCStringLen enc)