diff --git a/hbs2-git3/app/GitRemoteHelper.hs b/hbs2-git3/app/GitRemoteHelper.hs index c423183e..c277550e 100644 --- a/hbs2-git3/app/GitRemoteHelper.hs +++ b/hbs2-git3/app/GitRemoteHelper.hs @@ -39,9 +39,6 @@ getLine = liftIO IO.getLine sendLine :: MonadIO m => String -> m () sendLine = liftIO . IO.putStrLn -die :: forall a m . (MonadIO m, Pretty a) => a -> m () -die s = liftIO $ Exit.die (show $ pretty s) - parseCLI :: MonadIO m => m [Syntax C] parseCLI = do argz <- liftIO getArgs diff --git a/hbs2-git3/lib/HBS2/Git3/Prelude.hs b/hbs2-git3/lib/HBS2/Git3/Prelude.hs index 0f0703a1..293ba4e5 100644 --- a/hbs2-git3/lib/HBS2/Git3/Prelude.hs +++ b/hbs2-git3/lib/HBS2/Git3/Prelude.hs @@ -124,6 +124,8 @@ instance (Ord k, Hashable k) => Cached (CacheFixedHPSQ k v) k v where quit :: MonadUnliftIO m => m () quit = liftIO Q.exitSuccess +die :: (MonadUnliftIO m, Pretty a) => a -> m () +die x = liftIO $ Q.die (show $ pretty x) pattern GitHashLike:: forall {c} . GitHash -> Syntax c pattern GitHashLike x <- ( diff --git a/hbs2-git3/lib/HBS2/Git3/Repo/Fork.hs b/hbs2-git3/lib/HBS2/Git3/Repo/Fork.hs index 7b673f7a..dddc5033 100644 --- a/hbs2-git3/lib/HBS2/Git3/Repo/Fork.hs +++ b/hbs2-git3/lib/HBS2/Git3/Repo/Fork.hs @@ -14,10 +14,13 @@ import HBS2.CLI.Run.Internal.Merkle (createTreeWithMetadata) import HBS2.System.Dir import HBS2.Git3.Config.Local +import HBS2.Git3.Logger import Data.Config.Suckless.Script import Data.Config.Suckless.Almost.RPC +import Data.Maybe + import Codec.Compression.Zstd.Streaming qualified as ZstdS import Codec.Compression.Zstd.Streaming (Result(..)) import Data.ByteString.Builder as Builder @@ -53,16 +56,37 @@ forkEntries prefix = do <+> "creates a new lww reference," <+> "adds this key to hbs2-keyman," <> line <> "creates default repo manifest") - $ args [ arg "key" "repo-ref" ] + $ args [ arg "key" "repo-ref" + ] $ examples [qc| hbs2-git repo:fork EvP3kskPVuKuKVMUc3LnfdW7GcFYjz6f5fFU1EGzrdgk |] $ entry $ bindMatch (prefix <> "fork") $ nil_ $ \case - [ SignPubKeyLike what ] -> lift do + [ SignPubKeyLike forked ] -> lift do - debug $ "call fucking initRepo" <+> pretty [newRepoOpt] + connectedDo do + setGitRepoKey forked + waitRepo Nothing - initRepo [newRepoOpt] + -- hereGit <- gitDir + + -- when (isJust hereGit) do + -- die "This is an existing git repo. Start from scratch, please. Fork operation aborted" + + -- debug $ "call fucking initRepo" <+> pretty [newRepoOpt] + + -- env <- ask + -- withGit3Env env do + -- initRepo [newRepoOpt] + + -- envNew <- nullGit3Env + -- none + -- connectedDo do + -- notice "SHIT!" + -- none + + -- newRepo <- getGitRepoKey >>= orThrowUser "can't create new repo" + -- notice $ yellow "new repo key" <+> pretty (AsBase58 newRepo) _ -> throwIO $ BadFormException @C nil