wip, applying log

.fixme-new/config

@@ -54,7 +54,7 @@ fixme-comments ";" "--"
 
 (define (ls) (report))
 
-(define (ls:wip) (report workflow ~ wip))
+(define (lss s) (report workflow ~ s))
 
 (define (stage) (fixme:stage:show))
 

fixme-new/lib/Fixme/Run.hs

@@ -50,7 +50,11 @@ import System.IO qualified as IO
 
 {- HLINT Ignore "Functor law" -}
 
-runFixmeCLI :: FixmePerks m => FixmeM m a -> m a
+withFixmeCLI :: FixmePerks m => FixmeEnv -> FixmeM m a -> m a
+withFixmeCLI env m = do
+  runReaderT (fromFixmeM m) env
+
+runFixmeCLI :: forall a m . FixmePerks m => FixmeM m a -> m a
 runFixmeCLI m = do
   dbPath <- localDBPath
   git <- findGitDir
@@ -127,9 +131,11 @@ runCLI = do
 
   runTop forms
 
-runTop :: FixmePerks m => [Syntax C] -> FixmeM m ()
+runTop :: forall m . FixmePerks m => [Syntax C] -> FixmeM m ()
 runTop forms = do
 
+  tvd  <- newTVarIO mempty
+
   let dict = makeDict @C do
 
        internalEntries
@@ -263,8 +269,12 @@ runTop forms = do
         _ -> throwIO $ BadFormException @C nil
 
        entry $ bindMatch "fixme:log:import" $ nil_ \case
-        [StringLike fn] -> do
-           lift $ importFromLog fn
+        [StringLike fn] -> lift do
+           env <- ask
+           d   <- readTVarIO tvd
+           importFromLog fn $ \ins -> do
+              void $ run d ins
+           updateIndexes
 
         _ -> throwIO $ BadFormException @C nil
 
@@ -272,6 +282,20 @@ runTop forms = do
         fme <- lift listFixmies
         pure ()
 
+       entry $ bindMatch "deleted" $ nil_ $ \case
+         [TimeStampLike _, FixmeHashLike hash] -> lift do
+           trace $ red "deleted" <+> pretty hash
+           deleteFixme hash
+
+         _ -> pure ()
+
+       entry $ bindMatch  "modified" $ nil_ $ \case
+        [TimeStampLike _, FixmeHashLike hash, StringLike a, StringLike b] -> do
+          trace $ red "modified!" <+> pretty hash <+> pretty a <+> pretty b
+          lift $ updateFixme Nothing hash (fromString a) (fromString b)
+
+        _ -> pure ()
+
        entry $ bindMatch "delete" $ nil_ \case
          [FixmeHashLike hash] -> lift $ delete hash
 
@@ -287,6 +311,12 @@ runTop forms = do
           stage <- lift selectStage
           liftIO $ print $ vcat (fmap pretty stage)
 
+       entry $ bindMatch "fixme:state:drop" $ nil_ $ const do
+          lift cleanupDatabase
+
+       entry $ bindMatch "fixme:state:clean" $ nil_ $ const do
+          lift cleanupDatabase
+
        entry $ bindMatch "fixme:stage:drop" $ nil_ $ const do
           lift cleanStage
 
@@ -336,5 +366,9 @@ runTop forms = do
   let args = zipWith (\i s -> bindValue (mkId ("$_" <> show i)) (mkStr @C s )) [1..] argz
                & HM.unions
 
-  run (dict <> args) (conf <> forms) >>= eatNil display
+  let finalDict = dict <> args -- :: Dict C (FixmeM m)
+
+  atomically $ writeTVar tvd finalDict
+
+  run finalDict (conf <> forms) >>= eatNil display
 

fixme-new/lib/Fixme/Run/Internal.hs

@@ -180,8 +180,18 @@ exportToLog fn = do
 
   cleanStage
 
-importFromLog :: FixmePerks m => FilePath -> FixmeM m ()
-importFromLog fn = do
+
+sanitizeLog :: [Syntax c] -> [Syntax c]
+sanitizeLog lls = flip filter lls $ \case
+  ListVal (SymbolVal "deleted" : _) -> True
+  ListVal (SymbolVal "modified" : _) -> True
+  _ -> False
+
+importFromLog :: FixmePerks m
+              => FilePath
+              -> ([Syntax C] -> FixmeM m ())
+              -> FixmeM m ()
+importFromLog fn runIns = do
   fset <- listAllFixmeHashes
 
   sto <- compactStorageOpen @HbSync readonly fn
@@ -196,7 +206,7 @@ importFromLog fn = do
         Added _ fx  -> do
           let ha = hashObject @HbSync (serialise fx) & HashRef
           unless (HS.member ha fset) do
-            warn $ red "import" <+> viaShow (pretty ha)
+            debug $ red "import" <+> viaShow (pretty ha)
             lift $ S.yield (Right fx)
         w -> lift $ S.yield (Left $ fromRight mempty $ parseTop (show $ pretty w))
 
@@ -205,9 +215,7 @@ importFromLog fn = do
 
   let w = lefts toImport
 
-  for_ w $ \x -> do
-    liftIO $ print $ pretty x
-  -- runTop (mconcat w)
+  runIns (sanitizeLog $ mconcat w)
 
   unless (List.null toImport) do
     updateIndexes

fixme-new/lib/Fixme/State.hs

@@ -685,7 +685,6 @@ updateIndexes = withState $ transactional do
   update_ [qc|delete from fixmejson where fixme in (select distinct id from fixmedeleted)|]
 
 
-
 insertProcessed :: (FixmePerks m, MonadReader FixmeEnv m, Hashed HbSync w)
                 => w
                 -> DBPipeM m ()

fixme-new/lib/Fixme/Types.hs

@@ -302,7 +302,7 @@ newtype FixmeM m a = FixmeM { fromFixmeM :: ReaderT FixmeEnv m a }
                                       )
 
 
-fixmeEnvBare :: FixmePerks m => m FixmeEnv
+fixmeEnvBare :: forall m .  FixmePerks m => m FixmeEnv
 fixmeEnvBare =
   FixmeEnv
     <$>  newMVar ()