mirror of https://github.com/voidlizard/hbs2
wip, debug
This commit is contained in:
parent
6e31a1e094
commit
49acdbe5f4
|
@ -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
|
||||
|
|
Binary file not shown.
|
@ -1 +1,2 @@
|
|||
.fixme-new/log merge=fixme-log-merge
|
||||
.fixme-new/fixme.log merge=fixme-log-merge
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue