wip

fixme-new/lib/Fixme/Run.hs

@@ -520,50 +520,49 @@ run what = do
 
           warn  $ red "GENERATE FORMS? FROM STAGE"
 
-          what <- selectStage @C
+          what <- selectStage
 
           for_ what $ \w -> do
             warn $ pretty w
 
           warn  $ red "ADD RECORDS FROM STAGE TO BINARY LOG"
 
-          sto <- compactStorageOpen @HbSync mempty fn
+          -- sto <- compactStorageOpen @HbSync mempty fn
 
-          wtf <- S.toList_ $ runMaybeT do
+          -- wtf <- S.toList_ $ runMaybeT do
-                  rv <- MaybeT $ getRef sto logRootKey
+          --         rv <- MaybeT $ getRef sto logRootKey
-                  walkMerkle rv (getBlock sto) $ \case
+          --         walkMerkle rv (getBlock sto) $ \case
-                    Left{} -> pure ()
+          --           Left{} -> pure ()
-                    Right (xs :: [Text]) -> do
+          --           Right (xs :: [Text]) -> do
-                      let what = fmap parseTop xs & rights & mconcat
+          --             let what = fmap parseTop xs & rights & mconcat
-                      lift $ mapM_ S.yield (sanitizeLog what)
+          --             lift $ mapM_ S.yield (sanitizeLog what)
 
-          let theLog = Set.fromList (wtf <> what) & Set.toList
+          -- let theLog = Set.fromList (wtf <> what) & Set.toList
-          -- FIXME: mtree-params-hardcode
+          -- -- FIXME: mtree-params-hardcode
 
-          let new = theLog & fmap ( fromString @Text . show . pretty )
+          -- let new = theLog & fmap ( fromString @Text . show . pretty )
-          let pt = toPTree (MaxSize 1024) (MaxNum 256) new
+          -- let pt = toPTree (MaxSize 1024) (MaxNum 256) new
 
-          -- FIXME: fuck-the-fucking-scientific
+          -- -- FIXME: fuck-the-fucking-scientific
-          --  сраный Scientiс не реализует Generic
+          -- --  сраный Scientiс не реализует Generic
-          --  и не открывает конструкторы, нельзя
+          -- --  и не открывает конструкторы, нельзя
-          --  сделать инстанс Serialise.
+          -- --  сделать инстанс Serialise.
-          --  надо выпилить его к херам. а пока вот так
+          -- --  надо выпилить его к херам. а пока вот так
-          h <- makeMerkle 0 pt $ \(_,_,bss) -> do
+          -- h <- makeMerkle 0 pt $ \(_,_,bss) -> do
-                 void $ putBlock sto bss
+          --        void $ putBlock sto bss
 
-          updateRef sto logRootKey h
+          -- updateRef sto logRootKey h
 
-          compactStorageClose sto
+          -- compactStorageClose sto
 
-          liftIO $ print $ vcat (fmap pretty new)
+          -- liftIO $ print $ vcat (fmap pretty new)
 
           warn  $ red "DELETE STAGE"
           warn  $ red "SCAN BINARY LOG?"
           warn  $ red "RUN NEW FORMS"
 
-          liftIO $ withFixmeEnv env (runForms theLog)
+          -- liftIO $ withFixmeEnv env (runForms theLog)
-
+          -- cleanStage
-          cleanStage
 
         ListVal [SymbolVal "no-debug"] -> do
           setLoggingOff @DEBUG
@@ -581,19 +580,20 @@ run what = do
           cleanStage
 
         ListVal [SymbolVal "builtin:show-stage"] -> do
-          stage <- selectStage @C
+          stage <- selectStage
           liftIO $ print $ vcat (fmap pretty stage)
 
         ListVal [SymbolVal "builtin:show-log", StringLike fn] -> do
           sto <- compactStorageOpen @HbSync readonly fn
 
-          void $ runMaybeT do
+          -- FIXME: re-implement
-            rv <- MaybeT $ getRef sto logRootKey
+          -- void $ runMaybeT do
+          --   rv <- MaybeT $ getRef sto logRootKey
 
-            walkMerkle rv (getBlock sto) $ \case
+          --   walkMerkle rv (getBlock sto) $ \case
-              Left{} -> error "malformed log"
+          --     Left{} -> error "malformed log"
-              Right (xs :: [Text]) -> do
+          --     Right (xs :: [Text]) -> do
-                liftIO $ mapM_ (print  . pretty) xs
+          --       liftIO $ mapM_ (print  . pretty) xs
 
           compactStorageClose sto
 

fixme-new/lib/Fixme/State.hs

@@ -570,22 +570,21 @@ insertFixmeDelStaged hash = withState do
             |] (hash,ts)
 
 
-type StageModRow = (Text,Integer,Text,Text)
+type StageModRow = (HashRef,Word64,Text,Text)
 
-selectStageModified :: (IsContext c,FixmePerks m,MonadReader FixmeEnv m) => m [Syntax c]
+selectStageModified :: (FixmePerks m,MonadReader FixmeEnv m) => m [CompactAction]
 selectStageModified = withState do
   what <- select_ @_ @StageModRow [qc|select hash,ts,attr,value from fixmestagemod|]
   for what $ \(h,t,k,v) -> do
-    pure $ mklist [mksym "modified", mkint t, mkstr h, mkstr k, mkstr v]
+    pure $ Modified t h (FixmeAttrName k) (FixmeAttrVal v)
 
-
+selectStageDeleted :: (FixmePerks m,MonadReader FixmeEnv m) => m [CompactAction]
-selectStageDeleted :: (IsContext c,FixmePerks m,MonadReader FixmeEnv m) => m [Syntax c]
 selectStageDeleted = withState do
-  what <- select_ @_ @(Text,Word64) [qc|select hash,ts from fixmestagedel|]
+  what <- select_ @_ @(HashRef,Word64) [qc|select hash,ts from fixmestagedel|]
   for what $ \(h,t) -> do
-    pure $ mklist [mksym "deleted", mkstr h]
+    pure $ Deleted t h
 
-selectStage :: (IsContext c,FixmePerks m,MonadReader FixmeEnv m) => m [Syntax c]
+selectStage :: (FixmePerks m,MonadReader FixmeEnv m) => m [CompactAction]
 selectStage = do
   a <- selectStageModified
   b <- selectStageDeleted

fixme-new/lib/Fixme/Types.hs

@@ -66,6 +66,12 @@ class IsContext c => MkStr c a where
 instance IsContext c => MkStr c FixmeAttrVal where
   mkstr (s :: FixmeAttrVal)  = Literal (noContext @c) (LitStr (coerce s))
 
+instance IsContext c => MkStr c FixmeAttrName where
+  mkstr (s :: FixmeAttrName)  = Literal (noContext @c) (LitStr (coerce s))
+
+instance IsContext c => MkStr c HashRef where
+  mkstr s  = Literal (noContext @c) (LitStr (fromString $ show $ pretty s))
+
 instance IsContext c => MkStr c Text where
   mkstr = Literal noContext . LitStr
 
@@ -182,8 +188,10 @@ data CompactAction =
 
 instance Pretty CompactAction where
   pretty = \case
-    Deleted s r -> pretty $ mklist @C [ mksym "deleted"  ]
+    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 ]
 
+instance Serialise CompactAction
 
 data FixmeTemplate =
   Simple SimpleTemplate