From a6b7b91988c8cebae58086becf3da78e79ce0966 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Wed, 5 Apr 2023 16:30:15 +0300 Subject: [PATCH] merged 3qQz3NXAeX [] git-hbs2-show --- .fixme/log | 5 ++- hbs2-git/git-hbs2/Main.hs | 13 +++--- hbs2-git/git-hbs2/RunShow.hs | 43 ++++++++++++++------ hbs2-git/lib/HBS2Git/Config.hs | 69 +++++++++++++++++--------------- hbs2-git/lib/HBS2Git/ListRefs.hs | 67 +++++++++++++++++++++++++++---- 5 files changed, 138 insertions(+), 59 deletions(-) diff --git a/.fixme/log b/.fixme/log index 7ef0915a..e7e8cb13 100644 --- a/.fixme/log +++ b/.fixme/log @@ -1,2 +1,3 @@ -(fixme-set "assigned" "voidlizard" "vksb7zZbUm") -(fixme-set "workflow" "wip" "vksb7zZbUm") +(fixme-set "workflow" "test" "3qQz3NXAeX") + +(fixme-set "assigned" "3qQz3NXAeX" "voidlizard") \ No newline at end of file diff --git a/hbs2-git/git-hbs2/Main.hs b/hbs2-git/git-hbs2/Main.hs index c44a9ab1..a1d4a59e 100644 --- a/hbs2-git/git-hbs2/Main.hs +++ b/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 - ref <- strArgument (metavar "HASH-REF") - pure $ runApp NoLog (runShow ref) + showReader s = if s == "config" + then Just ShowConfig + else ShowRef <$> fromStringMay s + pShow = do + object <- optional $ + argument (maybeReader showReader) (metavar "object" <> help " | config") + pure $ runApp NoLog (runShow object) diff --git a/hbs2-git/git-hbs2/RunShow.hs b/hbs2-git/git-hbs2/RunShow.hs index 66143291..3b3e3b34 100644 --- a/hbs2-git/git-hbs2/RunShow.hs +++ b/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 () -runShow h = do - shutUp - setLogging @INFO infoPrefix +data ShowObject = ShowRef RepoRef | ShowConfig +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) - info $ "head:" <+> pretty hd - info $ "last operations:" <> line +showRefs :: MonadIO m => App m () +showRefs = do + liftIO $ print $ pretty "References:" + runListRefs - for_ imported $ \(t,h1,h2) -> do - info $ pretty t <+> pretty h1 <+> pretty h2 +showConfig :: MonadIO m => App m () +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 diff --git a/hbs2-git/lib/HBS2Git/Config.hs b/hbs2-git/lib/HBS2Git/Config.hs index b5544b3d..c2b0e5f6 100644 --- a/hbs2-git/lib/HBS2Git/Config.hs +++ b/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" - - trace "locating .git directory" - - 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 - + ConfigPathInfo{..} <- getConfigPathInfo + here <- doesDirectoryExist configDir unless here do - debug $ "create directory" <+> pretty confP - createDirectoryIfMissing True confP - - let confFile = confP "config" - - confHere <- doesFileExist confFile - + debug $ "create directory" <+> pretty configDir + createDirectoryIfMissing True configDir + confHere <- doesFileExist configFilePath unless confHere do - appendFile confFile "" - - cfg <- readFile confFile <&> parseTop <&> either mempty id - - pure (pwd, cfg) - - - + appendFile configFilePath "" + cfg <- readFile configFilePath <&> parseTop <&> either mempty id + pure (configRepoParentDir, cfg) diff --git a/hbs2-git/lib/HBS2Git/ListRefs.hs b/hbs2-git/lib/HBS2Git/ListRefs.hs index f57381fb..717b050c 100644 --- a/hbs2-git/lib/HBS2Git/ListRefs.hs +++ b/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