merged 3qQz3NXAeX [] git-hbs2-show

.fixme/log

@@ -1,2 +1,3 @@
-(fixme-set "assigned" "voidlizard" "vksb7zZbUm")
+(fixme-set "workflow" "test" "3qQz3NXAeX")
-(fixme-set "workflow" "wip" "vksb7zZbUm")
+
+(fixme-set "assigned" "3qQz3NXAeX" "voidlizard")

hbs2-git/git-hbs2/Main.hs

@@ -1,7 +1,6 @@
 module Main where
 
 import HBS2.Prelude
-import HBS2.System.Logger.Simple hiding (info)
 
 import HBS2Git.App
 import HBS2Git.Export
@@ -23,7 +22,7 @@ main = join . customExecParser (prefs showHelpOnError) $
     parser ::  Parser (IO ())
     parser = hsubparser (  command "export"    (info pExport (progDesc "export repo"))
                         <> command "list-refs" (info pListRefs (progDesc "list refs"))
-                        <> command "show"      (info pShow  (progDesc "show current state"))
+                        <> command "show"      (info pShow (progDesc "show various types of objects"))
                         )
 
     pExport = do
@@ -34,7 +33,11 @@ main = join . customExecParser (prefs showHelpOnError) $
     pListRefs = do
       pure $ runApp NoLog runListRefs
 
-    pShow = do
+    showReader s = if s == "config"
-      ref <- strArgument (metavar "HASH-REF")
+      then Just ShowConfig
-      pure $ runApp NoLog (runShow ref)
+      else ShowRef <$> fromStringMay s
 
+    pShow = do
+      object <- optional $
+        argument (maybeReader showReader) (metavar "object" <> help "<HASH-REF> | config")
+      pure $ runApp NoLog (runShow object)

hbs2-git/git-hbs2/RunShow.hs

@@ -3,29 +3,46 @@ module RunShow where
 import HBS2.Prelude
 import HBS2.Base58
 
-import HBS2.System.Logger.Simple
-import HBS2.Git.Types
 import HBS2Git.App
 import HBS2Git.State
+import HBS2Git.Config 
+import HBS2Git.ListRefs
 
 import Data.Foldable
 
-runShow :: MonadIO m => RepoRef -> App m ()
+data ShowObject = ShowRef RepoRef | ShowConfig
-runShow h = do
-  shutUp
-  setLogging @INFO infoPrefix
 
+showRef :: MonadIO m => RepoRef -> App m ()
+showRef h = do
   db <- makeDbPath h >>= dbEnv
-
   withDB db do
-
     hd <- stateGetHead
     imported <- stateGetLastImported 10
+    liftIO $ do
+      print $ "current state for" <+> pretty (AsBase58 h)
+      print $ "head:" <+> pretty hd
+      print $ pretty "last operations:"
+      for_ imported (\(t,h1,h2) -> print $ pretty t <+> pretty h1 <+> pretty h2) 
 
-    info $ "current state for" <+> pretty (AsBase58 h)
+showRefs :: MonadIO m => App m ()
-    info $ "head:" <+> pretty hd
+showRefs = do
-    info $ "last operations:" <> line
+  liftIO $ print $ pretty "References:"
+  runListRefs
 
-    for_ imported $ \(t,h1,h2) -> do
+showConfig :: MonadIO m => App m ()
-      info $ pretty t <+> pretty h1 <+> pretty h2
+showConfig = liftIO do
+  ConfigPathInfo{..} <- getConfigPathInfo
+  cfg <- readFile configFilePath
+  print $ "Config file location:" <> line <> pretty configFilePath <> line
+  print $ "Config contents:" <> line <> pretty cfg
 
+showSummary :: MonadIO m => App m ()
+showSummary = do
+  showRefs
+  liftIO $ print $ pretty ""
+  showConfig
+
+runShow :: MonadIO m => Maybe ShowObject -> App m ()
+runShow (Just (ShowRef h)) = showRef h
+runShow (Just ShowConfig) = showConfig
+runShow Nothing = showSummary

hbs2-git/lib/HBS2Git/Config.hs

@@ -20,8 +20,10 @@ import System.Directory
 appName :: FilePath
 appName = "hbs2-git"
 
+-- Finds .git dir inside given directory moving upwards
 findGitDir :: MonadIO m => FilePath -> m (Maybe FilePath)
 findGitDir dir = liftIO do
+  trace "locating .git directory"
   let gitDir = dir </> ".git"
   exists <- doesDirectoryExist gitDir
   if exists
@@ -31,48 +33,51 @@ findGitDir dir = liftIO do
                then return Nothing
                else findGitDir parentDir
 
+-- Finds .git dir inside current directory moving upwards
+findWorkingGitDir :: MonadIO m => m FilePath
+findWorkingGitDir = do
+  this <- liftIO getCurrentDirectory
+  findGitDir this `orDie` ".git directory not found"
 
 configPath :: MonadIO m => FilePath -> m FilePath
 configPath pwd = liftIO do
   xdg <- liftIO $ getXdgDirectory XdgConfig appName
   home <- liftIO getHomeDirectory
-  gitDir <- findGitDir pwd `orDie` ".git directory not found"
   pure $ xdg </> makeRelative home pwd
 
+data ConfigPathInfo = ConfigPathInfo {
+  configRepoParentDir :: FilePath,
+  configDir :: FilePath,
+  configFilePath :: FilePath
+} deriving (Eq, Show)
+
+-- returns git repository parent dir, config directory and config file path 
+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
+    }
+
 -- returns current directory, where found .git directory
 configInit :: MonadIO m => m (FilePath, [Syntax C])
 configInit = liftIO do
   trace "configInit"
-
+  ConfigPathInfo{..} <- getConfigPathInfo
-  trace "locating .git directory"
+  here <- doesDirectoryExist configDir
-
-  this <- getCurrentDirectory
-
-  gitDir <- findGitDir this `orDie` ".git directory not found"
-
-  let pwd = takeDirectory gitDir
-
-  confP <- configPath pwd
-
-  trace $ "git dir" <+> pretty gitDir
-  trace $ "confPath:" <+> pretty confP
-
-  here <- doesDirectoryExist confP
-
   unless here do
-    debug $ "create directory" <+> pretty confP
+    debug $ "create directory" <+> pretty configDir
-    createDirectoryIfMissing True confP
+    createDirectoryIfMissing True configDir
-
+  confHere <- doesFileExist configFilePath
-  let confFile = confP </> "config"
-
-  confHere <- doesFileExist confFile
-
   unless confHere do
-    appendFile confFile ""
+    appendFile configFilePath ""
-
+  cfg <- readFile configFilePath <&> parseTop <&> either mempty id
-  cfg <- readFile confFile <&> parseTop <&> either mempty id
+  pure (configRepoParentDir, cfg)
-
-  pure (pwd, cfg)
-
-
-

hbs2-git/lib/HBS2Git/ListRefs.hs

@@ -1,19 +1,39 @@
 module HBS2Git.ListRefs where
 
 import HBS2Git.Types
+import HBS2.Prelude
 import HBS2Git.App
+import HBS2.Data.Types.Refs (HashRef)
 
 import HBS2.Git.Local.CLI
 
 import Data.Functor
-import Data.Text (Text)
 import Data.Text qualified as Text
-import Prettyprinter
+import Data.Traversable
 
-newtype AsRemoteEntry = AsRemoteEntry (Text,Text)
+data AsRemoteEntry = AsRemoteEntry
+  { remoteName :: Text,
+    remoteURL :: Text,
+    remoteRefValue :: Maybe HashRef
+  }
+
+remoteNameColWidth :: Int
+remoteNameColWidth = 16
+
+remoteURLColWidth :: Int
+remoteURLColWidth = 51
+
+remoteRefValueColWidth :: Int
+remoteRefValueColWidth = 44
 
 instance Pretty AsRemoteEntry where
-  pretty (AsRemoteEntry (x,y)) = fill 16 (pretty x) <+> pretty y
+  pretty (AsRemoteEntry {..}) =
+    fill remoteNameColWidth (pretty remoteName)
+      <+> fill remoteURLColWidth (pretty remoteURL)
+      <+> fill remoteRefValueColWidth (maybe "-" pretty remoteRefValue)
+
+hbs2Prefix :: Text
+hbs2Prefix = "hbs2://"
 
 -- TODO: backlog-list-refs-all-option
 --  сделать опцию --all которая выведет
@@ -23,8 +43,41 @@ instance Pretty AsRemoteEntry where
 runListRefs :: MonadIO m => App m ()
 runListRefs = do
   refs <- gitGetRemotes <&> filter isHbs2
-  liftIO $ print $ vcat (fmap (pretty.AsRemoteEntry) refs)
+  remoteEntries <-
-
+    forM
+      refs
+      ( \(name, url) -> do
+          refVal <- getRefVal url
+          pure $
+            AsRemoteEntry
+              { remoteName = name,
+                remoteURL = url,
+                remoteRefValue = refVal
+              }
+      )
+  let header =
+        fill remoteNameColWidth "Name"
+          <+> fill remoteURLColWidth "URL"
+          <+> fill remoteRefValueColWidth "Reference value"
+  liftIO $ print header
+  liftIO $ print $ vcat $ pretty <$> remoteEntries
   where
-    isHbs2 (_,b) = Text.isPrefixOf "hbs2://" b
+    isHbs2 (_, b) = Text.isPrefixOf hbs2Prefix b
 
+getRefVal :: (MonadIO m, HasCatAPI m) => Text -> m (Maybe HashRef)
+getRefVal url =
+  case Text.stripPrefix hbs2Prefix url of
+    Nothing -> do
+      liftIO $ print $ pretty "wrong URL format" <+> pretty url
+      pure Nothing
+    Just refStr -> case fromStringMay $ Text.unpack refStr of
+      Nothing -> do
+        liftIO $ print $ pretty "can't parse ref" <+> pretty refStr
+        pure Nothing
+      Just ref -> do
+        mRefVal <- readRefHttp ref
+        case mRefVal of
+          Nothing -> do
+            liftIO $ print $ pretty "readRefHttp error" <+> pretty ref
+            pure Nothing
+          Just v -> pure $ Just v