New git-based package manager now works as intended.

This commit is contained in:
Robin Heggelund Hansen 2021-12-30 14:21:47 +01:00
parent c9aeca00a3
commit 4c20a17cf7
2 changed files with 23 additions and 24 deletions

View File

@ -260,15 +260,14 @@ getRelevantVersions name constraint =
getRelevantVersionsHelper :: Stuff.PackageCache -> Pkg.Name -> IO (Maybe (V.Version, [V.Version]))
getRelevantVersionsHelper cache name = do
let home = Stuff.basePackage cache name
let path = home </> "elm.json"
outlineExists <- File.exists path
let repoPath = Stuff.basePackage cache name
repoExists <- Dir.doesDirectoryExist repoPath
_ <-
if outlineExists then
Git.update home
if repoExists then
Git.update repoPath
else
Git.clone (Git.githubUrl name) home
Git.tags home
Git.clone (Git.githubUrl name) repoPath
Git.tags repoPath
-- GET CONSTRAINTS

View File

@ -31,6 +31,7 @@ checkInstalledGit = do
newtype GitUrl
= GitUrl String
githubUrl :: Pkg.Name -> GitUrl
githubUrl pkg =
GitUrl $ "https://github.com/" ++ Pkg.toUrl pkg ++ ".git"
@ -38,21 +39,19 @@ githubUrl pkg =
clone :: GitUrl -> FilePath -> IO ()
clone (GitUrl gitUrl) targetFolder = do
nullHandle <- IO.openFile "/dev/null" IO.WriteMode
putStrLn $ "Cloning " ++ gitUrl
procResult <-
Process.createProcess
Process.readCreateProcessWithExitCode
(Process.proc "git" [ "clone" , "--bare", gitUrl, targetFolder ])
{ Process.std_out = Process.UseHandle nullHandle
, Process.std_err = Process.UseHandle nullHandle
}
""
return ()
localClone :: FilePath -> V.Version -> FilePath -> IO ()
localClone gitUrl vsn targetFolder = do
nullHandle <- IO.openFile "/dev/null" IO.WriteMode
putStrLn $ "Checking out " ++ gitUrl ++ " version " ++ V.toChars vsn
procResult <-
Process.createProcess
Process.readCreateProcessWithExitCode
(Process.proc "git"
[ "clone"
, gitUrl
@ -61,27 +60,28 @@ localClone gitUrl vsn targetFolder = do
, "--depth", "1"
, targetFolder
])
{ Process.std_out = Process.UseHandle nullHandle
, Process.std_err = Process.UseHandle nullHandle
}
""
return ()
update :: FilePath -> IO ()
update path = do
nullHandle <- IO.openFile "/dev/null" IO.WriteMode
putStrLn $ "Updating " ++ path
procResult <-
Process.createProcess
(Process.proc "git" [ "pull", "--tags" ])
{ Process.std_out = Process.UseHandle nullHandle
, Process.std_err = Process.UseHandle nullHandle
}
Process.readCreateProcessWithExitCode
((Process.proc "git" [ "pull", "--tags" ])
{ Process.cwd = Just path })
""
return ()
tags :: FilePath -> IO (Maybe (V.Version, [V.Version]))
tags path = do
(exitCode, stdout, stderr) <- Process.readProcessWithExitCode "git" [ "tag" ] ""
(exitCode, stdout, stderr) <-
Process.readCreateProcessWithExitCode
((Process.proc "git" [ "tag" ])
{ Process.cwd = Just path })
""
let tags = map BS.pack $ lines stdout
let versions = Either.rights $ map (Parser.fromByteString V.parser (,)) tags
case versions of