module Hinit.Process where import Control.Effect.Lift import Control.Effect.Terminal import Control.Effect.Throw import Data.Maybe import Hinit.Errors import Hinit.Types import Hinit.Utils import Path import Prettyprinter import System.Directory import System.Exit import System.IO (hGetContents) import System.Process vcsInitProc :: VCS -> Maybe CreateProcess vcsInitProc :: VCS -> Maybe CreateProcess vcsInitProc VCS Git = CreateProcess -> Maybe CreateProcess forall a. a -> Maybe a Just (CreateProcess -> Maybe CreateProcess) -> CreateProcess -> Maybe CreateProcess forall a b. (a -> b) -> a -> b $ FilePath -> [FilePath] -> CreateProcess proc FilePath "git" [FilePath "init"] vcsInitProc VCS Mercurial = CreateProcess -> Maybe CreateProcess forall a. a -> Maybe a Just (CreateProcess -> Maybe CreateProcess) -> CreateProcess -> Maybe CreateProcess forall a b. (a -> b) -> a -> b $ FilePath -> [FilePath] -> CreateProcess proc FilePath "hg" [FilePath "init"] vcsInitProc VCS Darcs = CreateProcess -> Maybe CreateProcess forall a. a -> Maybe a Just (CreateProcess -> Maybe CreateProcess) -> CreateProcess -> Maybe CreateProcess forall a b. (a -> b) -> a -> b $ FilePath -> [FilePath] -> CreateProcess proc FilePath "darcs" [FilePath "init"] vcsInitProc VCS Pijul = CreateProcess -> Maybe CreateProcess forall a. a -> Maybe a Just (CreateProcess -> Maybe CreateProcess) -> CreateProcess -> Maybe CreateProcess forall a b. (a -> b) -> a -> b $ FilePath -> [FilePath] -> CreateProcess proc FilePath "pijul" [FilePath "init"] vcsInitProc (Other Text _) = Maybe CreateProcess forall a. Maybe a Nothing guessExecutableExists :: Has (Lift IO) sig m => CmdSpec -> m Bool guessExecutableExists :: CmdSpec -> m Bool guessExecutableExists ShellCommand {} = Bool -> m Bool forall (f :: Type -> Type) a. Applicative f => a -> f a pure Bool True guessExecutableExists (RawCommand FilePath exe [FilePath] _) = Maybe FilePath -> Bool forall a. Maybe a -> Bool isJust (Maybe FilePath -> Bool) -> m (Maybe FilePath) -> m Bool forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Maybe FilePath) -> m (Maybe FilePath) forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Lift IO) sig m => IO a -> m a sendIO (FilePath -> IO (Maybe FilePath) findExecutable FilePath exe) initVCS :: ( Has (Lift IO) sig m, Has (Throw ProcessExitFailure) sig m, Has Terminal sig m ) => VCS -> Path a Dir -> m () initVCS :: VCS -> Path a Dir -> m () initVCS VCS vcs Path a Dir dir = do Maybe CreateProcess -> (CreateProcess -> m ()) -> m () forall (m :: Type -> Type) a. Applicative m => Maybe a -> (a -> m ()) -> m () whenJust (VCS -> Maybe CreateProcess vcsInitProc VCS vcs) ((CreateProcess -> m ()) -> m ()) -> (CreateProcess -> m ()) -> m () forall a b. (a -> b) -> a -> b $ \CreateProcess process -> do Bool exists <- CmdSpec -> m Bool forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type). Has (Lift IO) sig m => CmdSpec -> m Bool guessExecutableExists (CmdSpec -> m Bool) -> CmdSpec -> m Bool forall a b. (a -> b) -> a -> b $ CreateProcess -> CmdSpec cmdspec CreateProcess process let cp :: CreateProcess cp = CreateProcess process { cwd :: Maybe FilePath cwd = FilePath -> Maybe FilePath forall a. a -> Maybe a Just (Path a Dir -> FilePath forall b t. Path b t -> FilePath toFilePath Path a Dir dir) } if Bool -> Bool not Bool exists then Doc AnsiStyle -> m () forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type). Has Terminal sig m => Doc AnsiStyle -> m () prettyPrintWarning (Doc AnsiStyle -> m ()) -> Doc AnsiStyle -> m () forall a b. (a -> b) -> a -> b $ VcsCmdNotFound -> Doc AnsiStyle forall a ann. Pretty a => a -> Doc ann pretty (VcsCmdNotFound -> Doc AnsiStyle) -> VcsCmdNotFound -> Doc AnsiStyle forall a b. (a -> b) -> a -> b $ VCS -> VcsCmdNotFound VcsCmdNotFound VCS vcs else CreateProcess -> m () forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type). (Has (Lift IO) sig m, Has (Throw ProcessExitFailure) sig m) => CreateProcess -> m () runProc CreateProcess cp runProc :: ( Has (Lift IO) sig m, Has (Throw ProcessExitFailure) sig m ) => CreateProcess -> m () runProc :: CreateProcess -> m () runProc CreateProcess cp = do ~(Maybe Handle _, Just Handle stdout, Just Handle stderr, ProcessHandle ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Lift IO) sig m => IO a -> m a sendIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)) -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) forall a b. (a -> b) -> a -> b $ CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess CreateProcess cp { std_out :: StdStream std_out = StdStream CreatePipe, std_err :: StdStream std_err = StdStream CreatePipe } ExitCode c <- IO ExitCode -> m ExitCode forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Lift IO) sig m => IO a -> m a sendIO (IO ExitCode -> m ExitCode) -> IO ExitCode -> m ExitCode forall a b. (a -> b) -> a -> b $ ProcessHandle -> IO ExitCode waitForProcess ProcessHandle ph case ExitCode c of ExitCode ExitSuccess -> () -> m () forall (f :: Type -> Type) a. Applicative f => a -> f a pure () ExitFailure Int i -> do FilePath out <- IO FilePath -> m FilePath forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Lift IO) sig m => IO a -> m a sendIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath forall a b. (a -> b) -> a -> b $ Handle -> IO FilePath hGetContents Handle stdout FilePath err <- IO FilePath -> m FilePath forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Lift IO) sig m => IO a -> m a sendIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath forall a b. (a -> b) -> a -> b $ Handle -> IO FilePath hGetContents Handle stderr ProcessExitFailure -> m () forall e (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a. Has (Throw e) sig m => e -> m a throwError (ProcessExitFailure -> m ()) -> ProcessExitFailure -> m () forall a b. (a -> b) -> a -> b $ CmdSpec -> Int -> FilePath -> FilePath -> ProcessExitFailure ProcessExitFailure (CreateProcess -> CmdSpec cmdspec CreateProcess cp) Int i FilePath out FilePath err