From 06970f527befbd1e461aaef4882cfdceefc81005 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Mon, 16 Oct 2023 15:42:13 +0300
Subject: [PATCH] git clone --mirror location bug fixed

---
 hbs2-git/lib/HBS2Git/Config.hs | 19 ++++++++++++-------
 hbs2-git/lib/HBS2Git/Import.hs | 16 ++++++++++++++--
 2 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/hbs2-git/lib/HBS2Git/Config.hs b/hbs2-git/lib/HBS2Git/Config.hs
index a03ac007..7813b2f5 100644
--- a/hbs2-git/lib/HBS2Git/Config.hs
+++ b/hbs2-git/lib/HBS2Git/Config.hs
@@ -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,
diff --git a/hbs2-git/lib/HBS2Git/Import.hs b/hbs2-git/lib/HBS2Git/Import.hs
index 587dc68f..d516b7e7 100644
--- a/hbs2-git/lib/HBS2Git/Import.hs
+++ b/hbs2-git/lib/HBS2Git/Import.hs
@@ -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