Revert "test PR ADibgyhKo6 hbs2-git-config-location"

This reverts commit 5b5639fc2b.

.fixme/log

@@ -1,2 +1,2 @@
 
-(fixme-set "workflow" "test" "ADibgyhKo6")
+(fixme-set "workflow" "test" "CG2C18TK8v")

.gitignore

@@ -3,6 +3,5 @@ dist-newstyle
 hbs2.prof
 .fixme/state.db
 result
-.hbs2-git
 # VS Code
 settings.json

docs/devlog.md

@@ -1,11 +1,3 @@
-## 2023-14-08
-
-PR: hbs2-git-config-location
-  branch: hbs2-git-fastpok
-  commit: 82d5a30f4510b3f70bfbf2bc208b14df4ce2b17d
-  Изменено расположение файла конфигурации hbs2-git,
-  незначительный рефакторинг.
-
 ## 2023-07-30
 
 какие-то косяки

hbs2-git/git-hbs2/GitRemoteMain.hs

@@ -8,7 +8,7 @@ import HBS2.Git.Types
 
 import HBS2.System.Logger.Simple
 
--- import HBS2Git.Types(traceTime)
+import HBS2Git.Types(traceTime)
 import HBS2Git.App
 import HBS2Git.State
 import HBS2Git.Import

hbs2-git/git-hbs2/GitRemotePush.hs

@@ -2,17 +2,17 @@
 module GitRemotePush where
 
 import HBS2.Prelude.Plated
--- import HBS2.Data.Types.Refs
+import HBS2.Data.Types.Refs
 import HBS2.OrDie
 import HBS2.System.Logger.Simple
--- import HBS2.Net.Auth.Credentials hiding (getCredentials)
+import HBS2.Net.Auth.Credentials hiding (getCredentials)
 
 import HBS2.Git.Local
 import HBS2.Git.Local.CLI
 
 import HBS2Git.Config as Config
 import HBS2Git.Types
--- import HBS2Git.State
+import HBS2Git.State
 import HBS2Git.App
 import HBS2Git.Export (exportRefOnly,exportRefDeleted)
 import HBS2Git.Import (importRefLogNew)
@@ -70,12 +70,12 @@ push :: forall  m . ( MonadIO m
 
 
 push remote what@[Just bFrom , Just br] = do
-  (_, config) <- Config.configInit
+  (_, syn) <- Config.configInit
 
-  -- dbPath <- makeDbPath remote
+  dbPath <- makeDbPath remote
-  -- db <- dbEnv dbPath
+  db <- dbEnv dbPath
 
-  runWithConfig config do
+  runWithConfig syn do
     _ <- cfgValue @ConfBranch  @(Set GitRef) <&> transformBi normalizeRef
     loadCredentials mempty
     trace $ "PUSH PARAMS" <+> pretty what
@@ -85,9 +85,9 @@ push remote what@[Just bFrom , Just br] = do
     pure (Just br)
 
 push remote [Nothing, Just br]  = do
-  (_, config) <- Config.configInit
+  (_, syn) <- Config.configInit
 
-  runWithConfig config do
+  runWithConfig syn do
     _ <- cfgValue @ConfBranch  @(Set GitRef) <&> transformBi normalizeRef
     loadCredentials mempty
     trace $ "deleting remote reference" <+> pretty br

hbs2-git/git-hbs2/RunShow.hs

@@ -1,24 +1,22 @@
 module RunShow where
 
 import HBS2.Prelude
--- import HBS2.Base58
+import HBS2.Base58
 
 import HBS2Git.App
--- import HBS2Git.State
+import HBS2Git.State
+import HBS2Git.Config
 import HBS2Git.ListRefs
 
 import Control.Monad.Catch (MonadMask)
-import Control.Monad.Reader
+import Data.Foldable
-import Lens.Micro.Platform
-
--- import Data.Foldable
 import Prettyprinter.Render.Terminal
 
 data ShowObject = ShowRef RepoRef | ShowConfig
 
 showRef :: (MonadIO m, MonadMask m) => RepoRef -> App m ()
-showRef _h = do
+showRef h = do
-  -- db <- makeDbPath h >>= dbEnv
+  db <- makeDbPath h >>= dbEnv
   -- FIXME: re-implement-showRef
   pure ()
   -- withDB db do
@@ -36,12 +34,11 @@ showRefs = do
   runListRefs
 
 showConfig :: (MonadIO m, MonadMask m) => App m ()
-showConfig = do
+showConfig = liftIO do
-  configPath <- asks $ view appConfPath
+  ConfigPathInfo{..} <- getConfigPathInfo
-  liftIO $ do
+  cfg <- readFile configFilePath
-    config <- readFile configPath
+  putDoc $ green "Config file location:" <> section <> pretty configFilePath <> section
-    putDoc $ green "Config file location:" <> section <> pretty configPath <> section
+  putDoc $ green "Config contents:" <> line <> pretty cfg
-    putDoc $ green "Config contents:" <> line <> pretty config <> line
 
 showSummary :: (MonadIO m, MonadMask m) => App m ()
 showSummary = do

hbs2-git/lib/HBS2/Git/Local/CLI.hs

@@ -32,6 +32,7 @@ import Data.Text.Encoding (decodeLatin1)
 import Data.Text qualified as Text
 import System.Process.Typed
 import Text.InterpolatedString.Perl6 (qc)
+import Lens.Micro.Platform
 import Control.Monad.Trans.Maybe
 import System.IO
 
@@ -140,7 +141,7 @@ gitGetAllDependencies :: MonadIO m
                        -> ( GitHash -> IO () ) -- ^ progress update function
                        -> m [(GitHash, GitHash)]
 
-gitGetAllDependencies n objects lookup' progress = liftIO do
+gitGetAllDependencies n objects lookup progress = liftIO do
   input <- newTQueueIO
   output <- newTQueueIO
 
@@ -174,7 +175,7 @@ gitGetAllDependencies n objects lookup' progress = liftIO do
             pure here
 
           unless done do
-            cached <- lookup' h
+            cached <- lookup h
 
             deps <- if null cached then do
                       gitGetDependencies h
@@ -249,7 +250,7 @@ gitConfigSet k v = do
 gitGetRemotes :: MonadIO m => m [(Text,Text)]
 gitGetRemotes = do
   let cmd = [qc|git config --get-regexp '^remote\..*\.url$'|]
-  (_, out, _) <- liftIO $ readProcess (shell cmd)
+  (code, out, _) <- liftIO $ readProcess (shell cmd)
 
   let txt = Text.decodeUtf8 (LBS.toStrict out)
 

hbs2-git/lib/HBS2/Git/Types.hs

@@ -14,9 +14,14 @@ import Data.ByteString.Char8 qualified as BS
 import Data.ByteString.Lazy.Char8 qualified as LBS
 import Data.Data
 import Data.Generics.Uniplate.Data()
+import Data.String (IsString(..))
 import Data.Text.Encoding (decodeLatin1)
 import Data.Text qualified as Text
+import Data.Text (Text)
+import GHC.Generics
+import Prettyprinter
 import Text.InterpolatedString.Perl6 (qc)
+import Data.Hashable
 import Codec.Serialise
 import Data.Maybe
 

hbs2-git/lib/HBS2Git/App.hs

@@ -22,6 +22,7 @@ import HBS2.Defaults (defBlockSize)
 
 import HBS2Git.Types
 import HBS2Git.Config as Config
+import HBS2Git.State
 
 import Data.Maybe
 import Control.Monad.Trans.Maybe
@@ -183,8 +184,7 @@ runApp l m = do
     setLoggingOff @DEBUG
     setLoggingOff @TRACE
 
-  pwd <- Config.getRepoDir
+  (pwd, syn) <- Config.configInit
-  (configPath, config) <- Config.configInit
 
   xdgstate <- getAppStateDir
   -- let statePath = xdgstate </> makeRelative home pwd
@@ -203,11 +203,11 @@ runApp l m = do
 
   mtCred <- liftIO $ newTVarIO mempty
 
-  let env = AppEnv pwd (pwd </> ".git") config configPath xdgstate reQ szQ puQ rlQ mtCred
+  let env = AppEnv pwd (pwd </> ".git") syn xdgstate reQ szQ puQ rlQ mtCred
 
   runReaderT (fromApp m) env
 
-  debug $ vcat (fmap pretty config)
+  debug $ vcat (fmap pretty syn)
 
   setLoggingOff @DEBUG
   setLoggingOff @ERROR
@@ -455,12 +455,9 @@ loadCredentials fp = do
     pure ()
 
 
-green :: Doc AnsiStyle -> Doc AnsiStyle
 green = annotate (color Green)
 
-yellow :: Doc AnsiStyle -> Doc AnsiStyle
 yellow = annotate (color Yellow)
 
-section :: Doc ann
 section = line <> line
 

hbs2-git/lib/HBS2Git/Config.hs

@@ -3,26 +3,23 @@ module HBS2Git.Config
   , module Data.Config.Suckless
   ) where
 
-import Data.Char (toLower)
-import Data.Config.Suckless
-import Data.Functor
-import HBS2.OrDie
 import HBS2.Prelude
 import HBS2.System.Logger.Simple
-import Prettyprinter.Render.Terminal
+import HBS2.OrDie
-import System.Directory
+
+import Data.Config.Suckless
+
+import HBS2Git.Types
+
+import Data.Functor
 import System.FilePath
-import System.IO
+import System.Directory
-import Text.InterpolatedString.Perl6 (qc)
 
 -- type C = MegaParsec
 
 appName :: FilePath
 appName = "hbs2-git"
 
-configFileName :: FilePath
-configFileName = "config"
-
 -- Finds .git dir inside given directory moving upwards
 findGitDir :: MonadIO m => FilePath -> m (Maybe FilePath)
 findGitDir dir = liftIO do
@@ -42,85 +39,45 @@ findWorkingGitDir = do
   this <- liftIO getCurrentDirectory
   findGitDir this `orDie` ".git directory not found"
 
-getRepoDir :: MonadIO m => m FilePath
+configPath :: MonadIO m => FilePath -> m FilePath
-getRepoDir = takeDirectory <$> findWorkingGitDir
+configPath pwd = liftIO do
-
-getOldConfigDir :: MonadIO m => FilePath -> m FilePath
-getOldConfigDir repoDir = liftIO do
   xdg <- liftIO $ getXdgDirectory XdgConfig appName
   home <- liftIO getHomeDirectory
-  pure $ xdg </> makeRelative home repoDir
+  pure $ xdg </> makeRelative home pwd
 
-getOldConfigPath :: MonadIO m => FilePath -> m FilePath
+data ConfigPathInfo = ConfigPathInfo {
-getOldConfigPath repoDir = do
+  configRepoParentDir :: FilePath,
-  oldConfigDir <- getOldConfigDir repoDir
+  configDir :: FilePath,
-  pure $ oldConfigDir </> configFileName
+  configFilePath :: FilePath
+} deriving (Eq, Show)
 
-getNewConfigDir :: FilePath -> FilePath
+-- returns git repository parent dir, config directory and config file path 
-getNewConfigDir repoDir = repoDir </> ("." <> appName)
+getConfigPathInfo :: MonadIO m => m ConfigPathInfo
+getConfigPathInfo = do
+  trace "getConfigPathInfo"
+  gitDir <- findWorkingGitDir
+  let pwd = takeDirectory gitDir
+  confP <- configPath pwd
+  let confFile = confP </> "config"
+  trace $ "git dir" <+> pretty gitDir
+  trace $ "confPath:" <+> pretty confP
+  pure ConfigPathInfo {
+      configRepoParentDir = pwd,
+      configDir = confP,
+      configFilePath = confFile
+    }
 
-getNewConfigPath :: FilePath -> FilePath
+-- returns current directory, where found .git directory
-getNewConfigPath repoDir = getNewConfigDir repoDir </> configFileName
-
-askPermissionToMoveConfig :: MonadIO m => FilePath -> FilePath -> m Bool
-askPermissionToMoveConfig oldConfigPath newConfigPath = do
-  liftIO $
-    putDoc
-      [qc|We've detected an existing config file in the old location: 
-{pretty oldConfigPath}
-
-The new location is:
-{pretty newConfigPath}
-
-Would you like to automatically move the config file to the new location? [Y/n] |]
-  liftIO $ hFlush stdout
-  response <- liftIO getLine
-  if map toLower response `elem` ["y", "yes"]
-    then pure True
-    else pure False
-
-isDirectoryEmpty :: FilePath -> IO Bool
-isDirectoryEmpty path = do
-  entries <- listDirectory path
-  return $ null entries
-
-getConfigPath :: MonadIO m => m FilePath
-getConfigPath = do
-  repoDir <- getRepoDir
-  oldConfigPath <- getOldConfigPath repoDir
-  let newConfigPath = getNewConfigPath repoDir
-  oldConfigExists <- liftIO $ doesFileExist oldConfigPath
-  if oldConfigExists
-    then do
-      permitted <- askPermissionToMoveConfig oldConfigPath newConfigPath
-      if permitted
-        then do
-          liftIO $ createDirectoryIfMissing True $ takeDirectory newConfigPath 
-          liftIO $ renameFile oldConfigPath newConfigPath
-          liftIO $ putDoc "Config file moved successfully."
-
-          -- also remove parent dir if it's empty
-          let oldConfigDir = takeDirectory oldConfigPath
-          isEmpty <- liftIO $ isDirectoryEmpty oldConfigDir
-          when isEmpty $ 
-            liftIO $ removeDirectory oldConfigDir
-
-          pure newConfigPath
-        else pure oldConfigPath
-    else pure newConfigPath
-
--- returns config file location and its content, if file it doesn't exist creates one
 configInit :: MonadIO m => m (FilePath, [Syntax C])
 configInit = liftIO do
   trace "configInit"
-  configPath <- getConfigPath
+  ConfigPathInfo{..} <- getConfigPathInfo
-  let configDir = takeDirectory configPath
+  here <- doesDirectoryExist configDir
-  configDirExists <- doesDirectoryExist configDir
+  unless here do
-  unless configDirExists do
     debug $ "create directory" <+> pretty configDir
     createDirectoryIfMissing True configDir
-  configExists <- doesFileExist configPath
+  confHere <- doesFileExist configFilePath
-  unless configExists do
+  unless confHere do
-    appendFile configPath ""
+    appendFile configFilePath ""
-  config <- readFile configPath <&> parseTop <&> either mempty id
+  cfg <- readFile configFilePath <&> parseTop <&> either mempty id
-  pure (configPath, config)
+  pure (configRepoParentDir, cfg)

hbs2-git/lib/HBS2Git/Export.hs

@@ -13,6 +13,7 @@ import HBS2.Data.Types.Refs
 import HBS2.OrDie
 import HBS2.System.Logger.Simple
 import HBS2.Net.Proto.Definition()
+import HBS2.Clock
 import HBS2.Base58
 
 import HBS2.Git.Local
@@ -157,7 +158,7 @@ writeLogSegments :: forall m . ( MonadIO m
                  -> [(GitLogEntry, LBS.ByteString)]
                  -> ExportT m [HashRef]
 
-writeLogSegments onProgress _val objs chunkSize trailing = do
+writeLogSegments onProgress val objs chunkSize trailing = do
 
   db          <- asks $ view exportDB
   written     <- asks $ view exportWritten
@@ -274,7 +275,7 @@ exportRefOnly _ remote rfrom ref val = do
 
   entries <- traceTime "gitRevList" $ gitRevList lastKnownRev val
 
-  let _entryNum = length entries
+  let entryNum = length entries
 
   -- NOTE: just-for-test-new-non-empty-push-to-another-branch-112
 
@@ -401,14 +402,15 @@ runExport fp repo = do
 
   shutUp
 
-  configPath  <- asks $ view appConfPath
+  cwd <- liftIO getCurrentDirectory
+  cfgPath <- configPath cwd
   let krf = fromMaybe "keyring-file" fp & takeFileName
 
   liftIO $ putStrLn ""
   liftIO $ putDoc $
     "exported" <+> pretty hhh
     <> section
-    <> green "Repository config:" <+> pretty configPath
+    <> green "Repository config:" <+> pretty (cfgPath </> "config")
     <> section
     <>  "Put the keyring file" <+> yellow (pretty krf) <+> "into a safe place," <> line
     <> "like encrypted directory or volume."

hbs2-git/lib/HBS2Git/State.hs

@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 module HBS2Git.State where
 
 import HBS2.Prelude
@@ -17,14 +16,19 @@ import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.ToField
 import Control.Monad.Reader
 import Text.InterpolatedString.Perl6 (qc)
+import Data.String
 import Data.ByteString.Lazy.Char8 qualified as LBS
 import System.Directory
 import System.FilePath
 import Data.Maybe
+import Data.Text (Text)
+import Prettyprinter
 import Data.UUID.V4 qualified as UUID
 import Control.Monad.Catch
 import Control.Concurrent.STM
+import System.IO.Unsafe
 import Data.Graph (graphFromEdges, topSort)
+import Data.Map qualified as Map
 import Lens.Micro.Platform
 
 -- FIXME: move-orphans-to-separate-module
@@ -102,7 +106,7 @@ dbEnvReadOnly = dbEnv0 none
 
 withDB :: (MonadIO m, MonadMask m) => DBEnv -> DB m a -> m a
 withDB env action = do
-  _conn <- initConnection env
+  conn <- initConnection env
   finally (runReaderT (fromDB action) env) $ do
     -- NOTE: we could not close connection here.
     pure ()

hbs2-git/lib/HBS2Git/Types.hs

@@ -26,17 +26,13 @@ import Control.Monad.IO.Class
 import Control.Monad.Reader
 import Database.SQLite.Simple (Connection)
 import Data.Char (isSpace)
-import Data.Set qualified as Set
-import Data.Set (Set)
 import Data.List qualified as List
-import Data.Maybe
 import Lens.Micro.Platform
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
 import Codec.Serialise
 import Control.Concurrent.STM
 import System.IO qualified as IO
-import UnliftIO.IO qualified as UIO
 import System.IO (Handle)
 import Data.Kind
 import Control.Monad.Catch
@@ -72,7 +68,6 @@ data AppEnv =
   { _appCurDir       :: FilePath
   , _appGitDir       :: FilePath
   , _appConf         :: [Syntax C]
-  , _appConfPath     :: FilePath
   , _appStateDir     :: FilePath
   , _appPeerHttpCat  :: API
   , _appPeerHttpSize :: API