belief-system-monad.ts

Author: xieyuheng

TODO.md

@@ -2,7 +2,6 @@
 
 > - https://github.com/cicada-lang/propagator/issues/3
 
-belief-system-monad.ts
 barometer-belief-system.test.ts
 `beliefSystemQuery`
 

src/monads/belief-monad.ts

@@ -5,7 +5,7 @@ import { bind, fmap, join } from "../monad/index.js"
 import { setUnion } from "../utils/Set.js"
 import { isFunction } from "../utils/isFunction.js"
 
-defineHandler(fmap, [isFunction, isBelief], (f, ma: Belief<any>) =>
+defineHandler(fmap, [isFunction, isBelief], (f, ma) =>
   Belief(bind(ma.value, f), ma.reason),
 )
 

src/monads/belief-system-monad.ts

@@ -0,0 +1,23 @@
+import { BeliefSystem, isBeliefSystem } from "../belief-system/index.js"
+import { Belief } from "../belief/index.js"
+import { defineHandler } from "../generic/index.js"
+import { fmap, join } from "../monad/index.js"
+import { isFunction } from "../utils/isFunction.js"
+
+defineHandler(fmap, [isFunction, isBeliefSystem], (f, ma: BeliefSystem<any>) =>
+  BeliefSystem(ma.beliefs.map((belief) => fmap(f, belief))),
+)
+
+defineHandler(join, [(mma) => isBeliefSystem(mma)], (mma: BeliefSystem<any>) =>
+  join(
+    BeliefSystem(
+      mma.beliefs.flatMap((belief) =>
+        isBeliefSystem(belief.value)
+          ? belief.value.beliefs.map((innerBelief) =>
+              Belief(innerBelief, belief.reason),
+            )
+          : [belief],
+      ),
+    ),
+  ),
+)

src/propagator/definePrimitive.ts

@@ -1,6 +1,7 @@
 import { Cell, addPropagator, put } from "../cell/index.js"
 import { naryFmap } from "../monad/index.js"
 import "../monads/belief-monad.js"
+import "../monads/belief-system-monad.js"
 import "../monads/nothing-monad.js"
 import { schedule } from "../scheduler/index.js"
 import type { MaybePromise } from "../utils/MaybePromise.js"