mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 16:56:29 +03:00
New git-based package manager now works as intended.
This commit is contained in:
parent
c9aeca00a3
commit
4c20a17cf7
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user