mirror of https://github.com/voidlizard/hbs2
git clone --mirror location bug fixed
This commit is contained in:
parent
a706af615e
commit
06970f527b
|
@ -19,9 +19,12 @@ import System.FilePath
|
|||
import System.Directory
|
||||
import Data.Maybe
|
||||
import Data.Either
|
||||
import Data.List (isSuffixOf)
|
||||
|
||||
import System.Environment
|
||||
|
||||
import System.IO (stderr)
|
||||
|
||||
appName :: FilePath
|
||||
appName = "hbs2-git"
|
||||
|
||||
|
@ -46,8 +49,6 @@ configPathOld pwd = liftIO do
|
|||
|
||||
configPath :: MonadIO m => FilePath -> m FilePath
|
||||
configPath _ = liftIO do
|
||||
env <- liftIO getEnvironment
|
||||
-- hPrint stderr $ pretty env
|
||||
pwd <- liftIO getCurrentDirectory
|
||||
git <- findGitDir pwd
|
||||
byEnv <- lookupEnv "GIT_DIR"
|
||||
|
@ -65,14 +66,18 @@ configPath _ = liftIO do
|
|||
let repo = or [True | SymbolVal @C "repositoryformatversion" <- universeBi gitConf ]
|
||||
|
||||
if core && bare && repo then do
|
||||
pure $ Just (pwd </> ".hbs2")
|
||||
pure $ Just pwd
|
||||
else
|
||||
pure Nothing
|
||||
|
||||
-- hPrint stderr appName
|
||||
-- hPrint stderr =<< getEnvironment
|
||||
path <- pure (git <|> byEnv <|> bare) `orDie` "*** hbs2-git: .git directory not found"
|
||||
pure (takeDirectory path </> ".hbs2")
|
||||
path <- pure (dropSuffix <$> (git <|> byEnv <|> bare)) `orDie` "*** hbs2-git: .git directory not found"
|
||||
|
||||
pure (path </> ".hbs2")
|
||||
|
||||
where
|
||||
dropSuffix s | isSuffixOf ".git/" s = takeDirectory s
|
||||
| isSuffixOf ".git" s = takeDirectory s
|
||||
| otherwise = s
|
||||
|
||||
data ConfigPathInfo = ConfigPathInfo {
|
||||
configRepoParentDir :: FilePath,
|
||||
|
|
|
@ -52,6 +52,8 @@ import Streaming.Zip qualified as SZip
|
|||
|
||||
import HBS2Git.PrettyStuff
|
||||
|
||||
import System.Environment
|
||||
|
||||
data RunImportOpts =
|
||||
RunImportOpts
|
||||
{ _runImportDry :: Maybe Bool
|
||||
|
@ -167,7 +169,14 @@ importRefLogNew opts ref = runResourceT do
|
|||
sto <- getStorage
|
||||
|
||||
let myTempDir = "hbs-git"
|
||||
temp <- liftIO getCanonicalTemporaryDirectory
|
||||
temp <- liftIO getTemporaryDirectory
|
||||
|
||||
wtf <- liftIO getEnvironment
|
||||
|
||||
hPrint stderr $ "CREATE TEMP DIR" <+> pretty temp <> line <> pretty wtf
|
||||
|
||||
-- liftIO $ void $ createDirectoryIfMissing True temp
|
||||
|
||||
(_,dir) <- allocate (createTempDirectory temp myTempDir) removeDirectoryRecursive
|
||||
|
||||
lift $ makePolled ref
|
||||
|
@ -408,7 +417,10 @@ importRefLogNew opts ref = runResourceT do
|
|||
|
||||
withDB db $ do
|
||||
stateUpdateCommitDepths
|
||||
statePutRefImported logRoot
|
||||
|
||||
when (length entries == length entries') do
|
||||
statePutRefImported logRoot
|
||||
|
||||
savepointRelease sp0
|
||||
|
||||
where
|
||||
|
|
Loading…
Reference in New Issue