wip

hbs2-git/hbs2-git-dashboard/src/HBS2/Git/DashBoard/State.hs

@@ -386,7 +386,7 @@ where rn = 1;
 createForksTable :: DashBoardPerks m => DBPipeM m ()
 createForksTable = do
   ddl [qc|
-    create table if not exists forks
+    create table if not exists fork
       ( a text not null
       , b text not null
       , primary key (a,b)
@@ -665,6 +665,29 @@ buildCommitTreeIndex lww = do
 
   for_ commits $ \co -> void $ runMaybeT do
     checkCommitProcessed co >>= guard . not
+    updateRepoData env co
+
+  updateForks
+
+  where
+
+    syntaxMap = Sky.defaultSyntaxMap
+
+    updateForks = withState do
+
+      S.insert [qc|
+        insert into fork (a,b)
+        select distinct r0.lww
+                        , r1.lww
+          from repocommit r0 join repocommit r1 on r0.kommit = r1.kommit and r0.lww <> r1.lww
+          where r0.lww = ?
+        on conflict (a,b) do nothing
+      |] (Only lww)
+
+      pure ()
+
+    updateRepoData env co  = do
+
       root <- getRootTree co >>= toMPlus
       (trees, blobs) <- getTreeRecursive co
 
@@ -697,9 +720,6 @@ buildCommitTreeIndex lww = do
                            , TreePath (headDef "" t)
                            )
 
-  where
-
-    syntaxMap = Sky.defaultSyntaxMap
 
     getTreeRecursive co = lift do
       dir <- repoDataPath lww