forked from filipg/gonito
rename dir to final dir
This commit is contained in:
parent
c1ed05edf0
commit
3dfec2d6f4
@ -11,7 +11,7 @@ import qualified Data.IntMap as IntMap
|
||||
import Network.URI
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Database.Persist.Sql (ConnectionPool, runSqlPool)
|
||||
import Database.Persist.Sql (ConnectionPool, runSqlPool, fromSqlKey)
|
||||
|
||||
import Control.Concurrent.Lifted (fork, threadDelay)
|
||||
|
||||
@ -19,6 +19,8 @@ import System.Process
|
||||
import System.Exit
|
||||
import System.Random
|
||||
|
||||
import System.Directory (renameDirectory)
|
||||
|
||||
import PersistSHA1
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
@ -86,16 +88,16 @@ cloneRepo url branch chan = do
|
||||
then do
|
||||
msg chan "Cloning..."
|
||||
r <- randomInt
|
||||
let repoDir = arena </> ("t" ++ show r)
|
||||
let tmpRepoDir = arena </> ("t" ++ show r)
|
||||
(exitCode, _) <- runProgram Nothing gitPath ["clone",
|
||||
"--progress",
|
||||
"--branch",
|
||||
T.unpack branch,
|
||||
T.unpack url,
|
||||
repoDir] chan
|
||||
tmpRepoDir] chan
|
||||
case exitCode of
|
||||
ExitSuccess -> do
|
||||
(exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan
|
||||
(exitCode, out) <- runProgram (Just tmpRepoDir) gitPath ["rev-parse", "HEAD"] chan
|
||||
case exitCode of
|
||||
ExitSuccess -> do
|
||||
msg chan $ concat ["HEAD commit is ", commitId]
|
||||
@ -108,6 +110,9 @@ cloneRepo url branch chan = do
|
||||
repoOwner=userId,
|
||||
repoReady=True,
|
||||
repoStamp=time }
|
||||
let repoDir = getRepoDir repoId
|
||||
liftIO $ renameDirectory tmpRepoDir repoDir
|
||||
msg chan $ concat ["Repo is in ", (T.pack repoDir)]
|
||||
return $ Just repoId
|
||||
where commitId = T.replace "\n" "" out
|
||||
commitRaw = fromTextToSHA1 commitId
|
||||
@ -121,6 +126,10 @@ cloneRepo url branch chan = do
|
||||
err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText]
|
||||
return Nothing
|
||||
|
||||
getRepoDir :: Key Repo -> FilePath
|
||||
getRepoDir repoId = arena </> repoIdAsString
|
||||
where repoIdAsString = show $ fromSqlKey repoId
|
||||
|
||||
checkRepoUrl :: Text -> Bool
|
||||
checkRepoUrl url = case parsedURI of
|
||||
Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols)
|
||||
|
Loading…
Reference in New Issue
Block a user