wip, debug

This commit is contained in:
Dmitry Zuikov 2024-06-12 07:05:53 +03:00
parent 6e31a1e094
commit 49acdbe5f4
5 changed files with 44 additions and 4 deletions

View File

@ -30,8 +30,8 @@ fixme-file-comments "*.scm" ";"
fixme-comments ";" "--"
(fixme-update-action
(append-file ".fixme-new/log" $1)
(fixme-play-log-action
(import-fixmies ".fixme-new/fixme.log")
)
(fixme-play-log-action

BIN
.fixme-new/fixme.log Normal file

Binary file not shown.

1
.gitattributes vendored
View File

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

View File

@ -14,6 +14,7 @@ import Fixme.Log
import HBS2.Git.Local.CLI
import HBS2.Base58
import HBS2.Merkle
import HBS2.Data.Types.Refs
import HBS2.Storage.Compact
@ -512,6 +513,11 @@ runForms ss = for_ ss $ \s -> do
ListVal [SymbolVal "deleted", FixmeHashLike hash] -> do
deleteFixme hash
ListVal [SymbolVal "added", FixmeHashLike _] -> do
-- we dont' add fixmies at that stage
-- but in fixme-import
none
ReadFixmeStdin -> readFixmeStdin
ListVal [SymbolVal "print-env"] -> printEnv
@ -557,6 +563,20 @@ runForms ss = for_ ss $ \s -> do
warn $ red "play-git-log-file-all" <+> pretty fn
scanGitLogLocal fn runForms
ListVal [SymbolVal "import-fixmies", StringLike fn] -> do
warn $ red "IMPORT-FIXMIES" <+> pretty fn
sto <- compactStorageOpen @HbSync mempty fn
ks <- keys sto
for_ ks $ \k -> runMaybeT do
v <- get sto k & MaybeT
warn $ red "import" <+> viaShow (toBase58 k)
fx <- deserialiseOrFail @Fixme (LBS.fromStrict v) & toMPlus
lift $ withState $ insertFixme fx
compactStorageClose sto
pure ()
ListVal [SymbolVal "export-fixmies", StringLike fn] -> do
e <- getEpoch
warn $ red "EXPORT-FIXMIES" <+> pretty fn

View File

@ -5,6 +5,7 @@ module Fixme.Types
) where
import Fixme.Prelude hiding (align)
import HBS2.Base58
import DBPipe.SQLite
import HBS2.Git.Local
@ -15,6 +16,7 @@ import Prettyprinter.Render.Terminal
import Control.Applicative
import Data.Aeson
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS8
import Data.ByteString.Lazy qualified as LBS
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HM
@ -77,9 +79,25 @@ instance MkId (String,Integer) where
class IsContext c => MkStr c a where
mkstr :: a -> Syntax c
instance IsContext c => MkStr c String where
mkstr s = Literal (noContext @c) (LitStr $ Text.pack s)
instance IsContext c => MkStr c ByteString where
mkstr s = Literal (noContext @c) (LitStr $ Text.pack $ BS8.unpack s)
instance IsContext c => MkStr c (Maybe FixmeKey) where
mkstr Nothing = Literal (noContext @c) (LitStr "")
mkstr (Just k) = Literal (noContext @c) (LitStr (coerce k))
instance IsContext c => MkStr c FixmeAttrVal where
mkstr (s :: FixmeAttrVal) = Literal (noContext @c) (LitStr (coerce s))
instance IsContext c => MkStr c (Maybe FixmeAttrVal) where
mkstr (Just v) = mkstr v
mkstr Nothing = mkstr ( "" :: Text )
instance IsContext c => MkStr c FixmeAttrName where
mkstr (s :: FixmeAttrName) = Literal (noContext @c) (LitStr (coerce s))
@ -210,14 +228,15 @@ class MkKey a where
instance MkKey CompactAction where
mkKey (Deleted _ h) = "D" <> LBS.toStrict (serialise h)
mkKey (Modified _ h _ _) = "M" <> LBS.toStrict (serialise h)
mkKey (Added _ fixme) = "A" <> LBS.toStrict (serialise fixme)
mkKey (Added _ fixme) = "A" <> coerce (hashObject @HbSync $ serialise fixme)
instance Pretty CompactAction where
pretty = \case
Deleted s r -> pretty $ mklist @C [ mksym "deleted", mkint s, mkstr r ]
Modified s r k v -> pretty $ mklist @C [ mksym "modified", mkint s, mkstr r, mkstr k, mkstr v ]
-- FIXME: normal-pretty-instance
Added w fx -> pretty $ mklist @C [ mksym "added", mksym "..." ]
e@(Added w fx) -> do
pretty $ mklist @C [ mksym "added", mkstr (toBase58 $ mkKey e) ]
instance Serialise CompactAction