monads.hoon

monads.hoon

|%
++  mebe
  |*  a=mold
  |%
  +$  form  (unit a)
  ++  pure
    |=  arg=a
    ^-  form
    `u=arg
  ++  bind
    |*  b=mold
    |=  [m-b=(unit b) fun=$-(b form)]
    ^-  form
    ?~  m-b
      ~
    (fun u.m-b)
  --
++  cheq
  |*  e=mold
  |*  a=mold
  |%
  +$  form  (each a e)
  ++  pure
    |=  ok=a
    ^-  form
    &+ok
  ++  bind
    |*  b=mold
    |=  [m-b=(each b e) fun=$-(b form)]
    ^-  form
    ?-  -.m-b
      %&  (fun p.m-b)
      %|  m-b
    ==
  --
++  tests
  |%
  ++  test-mebe-bind-null  ^-  tang
    =/  m  (mebe ,@)
    =/  a=form:m  ~
    %+  expect-eq
      !>  ((bind:m ,@) a |=(@ `u=(add 17 +<)))
      !>  `form:m`~
  ::
  ++  test-mebe-bind-pure  ^-  tang
    =/  m  (mebe ,@)
    =/  a=form:m  (pure:m 12)
    %+  expect-eq
      !>  ((bind:m ,@) a |=(@ `u=(add 17 +<)))
      !>  (pure:m 29)
  ::
  ++  test-mebe-mcgl  ^-  tang
    =/  m  (mebe ,@)
    =/  twelve
      ;<  x=@  bind:m  (pure:m 12)
      ;<  y=@  bind:m  `(add 17 x)
      (pure:m (sub y 17))
    %+  expect-eq
      !>  twelve
      !>  (pure:m 12)
  ::
  ++  test-cheq-bind-null  ^-  tang
    =/  m  ((cheq ,tang) ,@)
    =/  a=form:m  |+~
    %+  expect-eq
      !>  ((bind:m ,@) a |=(@ &+(add 17 +<)))
      !>  `form:m`|+~
  ::
  ++  test-cheq-bind-pure  ^-  tang
    =/  m  ((cheq ,tang) ,@)
    =/  a=form:m  (pure:m 12)
    %+  expect-eq
      !>  ((bind:m ,@) a |=(@ &+(add 17 +<)))
      !>  (pure:m 29)
  ::
  ++  test-cheq-mcgl  ^-  tang
    =/  m  ((cheq ,tang) ,@)
    =/  twelve
      ;<  x=@  bind:m  (pure:m 12)
      ;<  y=@  bind:m  &+(add 17 x)
      (pure:m (sub y 17))
    %+  expect-eq
      !>  twelve
      !>  (pure:m 12)
  --
--