rename dir to final dir

This commit is contained in:
Filip Gralinski 2015-09-04 10:51:53 +02:00
parent c1ed05edf0
commit 3dfec2d6f4
1 changed files with 13 additions and 4 deletions

View File

@ -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)