module Hinit.Process where

import Control.Effect.Lift
import Control.Effect.Terminal
import Control.Effect.Throw
import Control.Monad
import Data.Maybe
import Data.Text.Prettyprint.Doc
import Hinit.Errors
import Hinit.Types
import Hinit.Utils
import Path
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