diff --git a/.fixme-new/config b/.fixme-new/config index beba08dd..63a02fab 100644 --- a/.fixme-new/config +++ b/.fixme-new/config @@ -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 diff --git a/.fixme-new/fixme.log b/.fixme-new/fixme.log new file mode 100644 index 00000000..b3ca5f06 Binary files /dev/null and b/.fixme-new/fixme.log differ diff --git a/.gitattributes b/.gitattributes index 0b4845a9..9b69395a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1 +1,2 @@ .fixme-new/log merge=fixme-log-merge +.fixme-new/fixme.log merge=fixme-log-merge diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index 4b942a6c..c626131a 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/fixme-new/lib/Fixme/Run.hs @@ -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 diff --git a/fixme-new/lib/Fixme/Types.hs b/fixme-new/lib/Fixme/Types.hs index 732eb86f..2872e2da 100644 --- a/fixme-new/lib/Fixme/Types.hs +++ b/fixme-new/lib/Fixme/Types.hs @@ -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