wip, merge driver

This commit is contained in:
Dmitry Zuikov 2024-06-03 20:16:19 +03:00
parent 91f6577a6e
commit 5a3900ad34
6 changed files with 30 additions and 2 deletions

Binary file not shown.

1
.gitattributes vendored Normal file
View File

@ -0,0 +1 @@
.fixme-new/log merge=fixme-log-merge

View File

@ -84,10 +84,10 @@ common shared-properties
, streaming
, stm
, text
, temporary
, time
, timeit
, transformers
, typed-process
, unordered-containers
, unliftio

View File

@ -39,6 +39,8 @@ import Lens.Micro.Platform
import System.Process.Typed
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Maybe
import System.IO.Temp as Temp
import Streaming.Prelude qualified as S
@ -558,6 +560,26 @@ run what = do
compactStorageClose sto
ListVal [SymbolVal "git:merge",StringLike o, StringLike target, StringLike b] -> do
debug $ red "git:merge" <+> pretty o <+> pretty target <+> pretty b
temp <- liftIO $ emptyTempFile "." "merge-result"
sa <- compactStorageOpen @HbSync readonly o
sb <- compactStorageOpen @HbSync readonly b
r <- compactStorageOpen @HbSync mempty temp
for_ [sa,sb] $ \sto -> do
ks <- keys sto
for_ ks $ \k -> runMaybeT do
v <- get sto k & MaybeT
put r k v
compactStorageClose r
compactStorageClose sa
compactStorageClose sb
mv temp target
ListVal [SymbolVal "no-debug"] -> do
setLoggingOff @DEBUG

View File

@ -117,7 +117,6 @@ scanBlob fpath lbs = do
next (S (Sf (succEln env bs)) xs)
S _ [] -> pure ()
-- debug $ vcat (fmap viaShow parts)
S.toList_ do

View File

@ -69,6 +69,12 @@ expandPath = liftIO . D.canonicalizePath
doesDirectoryExist :: MonadIO m => FilePath -> m Bool
doesDirectoryExist = liftIO . D.doesDirectoryExist
fileSize :: MonadIO m => FilePath -> m Integer
fileSize = liftIO . D.getFileSize
mv :: MonadIO m => FilePath -> FilePath -> m ()
mv a b = liftIO $ D.renamePath a b
home :: MonadIO m => m FilePath
home = liftIO D.getHomeDirectory