mirror of https://github.com/voidlizard/hbs2
fix git hbs2 init
This commit is contained in:
parent
6069abb33e
commit
2962cc78ea
|
@ -194,7 +194,7 @@ runWithRPC action = do
|
||||||
| ListVal (Key "rpc" [SymbolVal "unix", LitStrVal n]) <- syn
|
| ListVal (Key "rpc" [SymbolVal "unix", LitStrVal n]) <- syn
|
||||||
]
|
]
|
||||||
|
|
||||||
soname <- race ( pause @'Seconds 1) (maybe (detectRPC False) pure soname') `orDie` "hbs2-peer rpc timeout!"
|
soname <- race ( pause @'Seconds 1) (maybe (detectRPC True) pure soname') `orDie` "hbs2-peer rpc timeout!"
|
||||||
|
|
||||||
client <- race ( pause @'Seconds 1) (newMessagingUnix False 1.0 soname) `orDie` "hbs2-peer rpc timeout!"
|
client <- race ( pause @'Seconds 1) (newMessagingUnix False 1.0 soname) `orDie` "hbs2-peer rpc timeout!"
|
||||||
|
|
||||||
|
|
|
@ -21,10 +21,10 @@ import HBS2Git.PrettyStuff
|
||||||
|
|
||||||
import Data.HashMap.Strict qualified as HashMap
|
import Data.HashMap.Strict qualified as HashMap
|
||||||
import Data.ByteString.Char8 qualified as BS8
|
import Data.ByteString.Char8 qualified as BS8
|
||||||
import Control.Monad.Trans.Maybe
|
|
||||||
import Data.Text qualified as Text
|
import Data.Text qualified as Text
|
||||||
import Data.Traversable
|
import Data.Traversable
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Either
|
||||||
import Prettyprinter.Render.Terminal
|
import Prettyprinter.Render.Terminal
|
||||||
import Control.Monad.IO.Unlift
|
import Control.Monad.IO.Unlift
|
||||||
import Control.Monad.Catch (MonadCatch,MonadThrow,MonadMask)
|
import Control.Monad.Catch (MonadCatch,MonadThrow,MonadMask)
|
||||||
|
@ -34,7 +34,6 @@ import System.FilePath
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Process.Typed
|
import System.Process.Typed
|
||||||
import Text.InterpolatedString.Perl6 (qc)
|
import Text.InterpolatedString.Perl6 (qc)
|
||||||
import System.FilePattern.Directory
|
|
||||||
import System.IO.Temp
|
import System.IO.Temp
|
||||||
import System.IO (stdout,stderr)
|
import System.IO (stdout,stderr)
|
||||||
|
|
||||||
|
@ -194,6 +193,23 @@ runInitInteractive opts = do
|
||||||
|
|
||||||
liftIO $ hPutStrLn stdout ""
|
liftIO $ hPutStrLn stdout ""
|
||||||
|
|
||||||
|
syn <- if not confHere then do
|
||||||
|
pure (mempty :: [Syntax C])
|
||||||
|
else do
|
||||||
|
liftIO $ try @_ @IOException (readFile confFile)
|
||||||
|
<&> fromRight mempty
|
||||||
|
<&> parseTop
|
||||||
|
<&> fromRight mempty
|
||||||
|
|
||||||
|
let rpcHere = or [ True | (SymbolVal "rpc" :: Syntax C) <- universeBi syn ]
|
||||||
|
|
||||||
|
maybe1 rpc none $ \r -> do
|
||||||
|
unless rpcHere $ liftIO do
|
||||||
|
appendFile confFile $ show
|
||||||
|
$ "rpc" <+> "unix" <+> dquotes (pretty r)
|
||||||
|
<> line
|
||||||
|
<> line
|
||||||
|
|
||||||
puk <- case view (field @"newRepoKeyring") opts of
|
puk <- case view (field @"newRepoKeyring") opts of
|
||||||
Just kr -> liftIO do
|
Just kr -> liftIO do
|
||||||
addKeyring confFile kr
|
addKeyring confFile kr
|
||||||
|
@ -249,7 +265,8 @@ runInitInteractive opts = do
|
||||||
|
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
liftIO $ hPutDoc stderr $ green "succeed!" <> line <> line
|
liftIO $ hPutDoc stderr $ green "Succeed!" <> line <> line
|
||||||
|
liftIO $ hPutDoc stderr $ pretty confFile <> line <> line
|
||||||
liftIO $ readFile confFile >>= putStrLn
|
liftIO $ readFile confFile >>= putStrLn
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in New Issue