wip

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

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 <- (

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