Repository: gcanti/fp-ts
Pull request #1387 (2021-02-02 03:30:07)

add Tree.unfoldTreeM and Tree.unfoldForestM
Migrate `Tree.unfoldTreeM` and `Tree.unfoldForestM` from 2.x



Patch:
diff --git a/docs/modules/Tree.ts.md b/docs/modules/Tree.ts.md
index 7545d68f..3e0d0d92 100644
--- a/docs/modules/Tree.ts.md
+++ b/docs/modules/Tree.ts.md
@@ -37,7 +37,9 @@ Added in v3.0.0
 - [constructors](#constructors)
   - [make](#make)
   - [unfoldForest](#unfoldforest)
+  - [unfoldForestM](#unfoldforestm)
   - [unfoldTree](#unfoldtree)
+  - [unfoldTreeM](#unfoldtreem)
 - [derivable combinators](#derivable-combinators)
   - [apFirst](#apfirst)
   - [apSecond](#apsecond)
@@ -212,6 +214,41 @@ export declare const unfoldForest: <B, A>(bs: readonly B[], f: (b: B) => readonl
 
 Added in v3.0.0
 
+## unfoldForestM
+
+Monadic forest builder, in depth-first order
+
+**Signature**
+
+```ts
+export declare function unfoldForestM<M extends URIS3>(
+  M: Monad3<M> & Applicative3<M>
+): <R, E, A, B>(
+  bs: ReadonlyArray<B>,
+  f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>
+) => Kind3<M, R, E, Forest<A>>
+export declare function unfoldForestM<M extends URIS3, E>(
+  M: Monad3C<M, E> & Applicative3C<M, E>
+): <R, A, B>(
+  bs: ReadonlyArray<B>,
+  f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>
+) => Kind3<M, R, E, Forest<A>>
+export declare function unfoldForestM<M extends URIS2>(
+  M: Monad2<M> & Applicative2<M>
+): <R, E, B>(bs: ReadonlyArray<B>, f: (b: B) => Kind2<M, R, readonly [E, ReadonlyArray<B>]>) => Kind2<M, R, Forest<E>>
+export declare function unfoldForestM<M extends URIS2, E>(
+  M: Monad2C<M, E> & Applicative2C<M, E>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => Kind2<M, E, readonly [A, ReadonlyArray<B>]>) => Kind2<M, E, Forest<A>>
+export declare function unfoldForestM<M extends URIS>(
+  M: Monad1<M> & Applicative1<M>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => Kind<M, readonly [A, ReadonlyArray<B>]>) => Kind<M, Forest<A>>
+export declare function unfoldForestM<M>(
+  M: Monad_<M> & Applicative_<M>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) => HKT<M, Forest<A>>
+```
+
+Added in v3.0.0
+
 ## unfoldTree
 
 Build a tree from a seed value
@@ -224,6 +261,35 @@ export declare const unfoldTree: <B, A>(b: B, f: (b: B) => readonly [A, readonly
 
 Added in v3.0.0
 
+## unfoldTreeM
+
+Monadic tree builder, in depth-first order
+
+**Signature**
+
+```ts
+export declare function unfoldTreeM<M extends URIS3>(
+  M: Monad3<M> & Applicative3<M>
+): <R, E, A, B>(b: B, f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>) => Kind3<M, R, E, Tree<A>>
+export declare function unfoldTreeM<M extends URIS3, E>(
+  M: Monad3C<M, E> & Applicative3C<M, E>
+): <R, A, B>(b: B, f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>) => Kind3<M, R, E, Tree<A>>
+export declare function unfoldTreeM<M extends URIS2>(
+  M: Monad2<M> & Applicative2<M>
+): <E, A, B>(b: B, f: (b: B) => Kind2<M, E, readonly [A, ReadonlyArray<B>]>) => Kind2<M, E, Tree<A>>
+export declare function unfoldTreeM<M extends URIS2, E>(
+  M: Monad2C<M, E> & Applicative2C<M, E>
+): <A, B>(b: B, f: (b: B) => Kind2<M, E, readonly [A, ReadonlyArray<B>]>) => Kind2<M, E, Tree<A>>
+export declare function unfoldTreeM<M extends URIS>(
+  M: Monad1<M> & Applicative1<M>
+): <A, B>(b: B, f: (b: B) => Kind<M, readonly [A, ReadonlyArray<B>]>) => Kind<M, Tree<A>>
+export declare function unfoldTreeM<M>(
+  M: Monad_<M> & Applicative_<M>
+): <A, B>(b: B, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) => HKT<M, Tree<A>>
+```
+
+Added in v3.0.0
+
 # derivable combinators
 
 ## apFirst
diff --git a/src/Tree.ts b/src/Tree.ts
index 60b3f770..d381e07d 100644
--- a/src/Tree.ts
+++ b/src/Tree.ts
@@ -7,7 +7,14 @@
  *
  * @since 3.0.0
  */
-import { Applicative as Applicative_, Applicative1 } from './Applicative'
+import {
+  Applicative as Applicative_,
+  Applicative1,
+  Applicative2,
+  Applicative2C,
+  Applicative3,
+  Applicative3C
+} from './Applicative'
 import { apFirst as apFirst_, Apply1, apSecond as apSecond_, apS as apS_, apT as apT_ } from './Apply'
 import { Comonad1 } from './Comonad'
 import { Eq, fromEquals } from './Eq'
@@ -15,8 +22,17 @@ import { Extend1 } from './Extend'
 import { Foldable1 } from './Foldable'
 import { identity, pipe } from './function'
 import { bindTo as bindTo_, Functor1, tupled as tupled_ } from './Functor'
-import { HKT } from './HKT'
-import { bind as bind_, chainFirst as chainFirst_, Monad1 } from './Monad'
+import { HKT, Kind, Kind2, Kind3, URIS, URIS2, URIS3 } from './HKT'
+import {
+  bind as bind_,
+  chainFirst as chainFirst_,
+  Monad1,
+  Monad2,
+  Monad2C,
+  Monad3,
+  Monad3C,
+  Monad as Monad_
+} from './Monad'
 import { Pointed1 } from './Pointed'
 import * as RA from './ReadonlyArray'
 import { Show } from './Show'
@@ -65,6 +81,40 @@ export const unfoldTree = <B, A>(b: B, f: (b: B) => readonly [A, ReadonlyArray<B
   return { value: a, forest: unfoldForest(bs, f) }
 }
 
+/**
+ * Monadic tree builder, in depth-first order
+ *
+ * @category constructors
+ * @since 3.0.0
+ */
+export function unfoldTreeM<M extends URIS3>(
+  M: Monad3<M> & Applicative3<M>
+): <R, E, A, B>(b: B, f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>) => Kind3<M, R, E, Tree<A>>
+export function unfoldTreeM<M extends URIS3, E>(
+  M: Monad3C<M, E> & Applicative3C<M, E>
+): <R, A, B>(b: B, f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>) => Kind3<M, R, E, Tree<A>>
+export function unfoldTreeM<M extends URIS2>(
+  M: Monad2<M> & Applicative2<M>
+): <E, A, B>(b: B, f: (b: B) => Kind2<M, E, readonly [A, ReadonlyArray<B>]>) => Kind2<M, E, Tree<A>>
+export function unfoldTreeM<M extends URIS2, E>(
+  M: Monad2C<M, E> & Applicative2C<M, E>
+): <A, B>(b: B, f: (b: B) => Kind2<M, E, readonly [A, ReadonlyArray<B>]>) => Kind2<M, E, Tree<A>>
+export function unfoldTreeM<M extends URIS>(
+  M: Monad1<M> & Applicative1<M>
+): <A, B>(b: B, f: (b: B) => Kind<M, readonly [A, ReadonlyArray<B>]>) => Kind<M, Tree<A>>
+export function unfoldTreeM<M>(
+  M: Monad_<M> & Applicative_<M>
+): <A, B>(b: B, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) => HKT<M, Tree<A>>
+export function unfoldTreeM<M>(
+  M: Monad_<M> & Applicative_<M>
+): <A, B>(b: B, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) => HKT<M, Tree<A>> {
+  const unfoldForestMM = unfoldForestM(M)
+  return <A, B>(b: B, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) =>
+    M.chain(([a, bs]: readonly [A, ReadonlyArray<B>]) =>
+      M.chain((ts: ReadonlyArray<Tree<A>>) => M.of({ value: a, forest: ts }))(unfoldForestMM(bs, f))
+    )(f(b))
+}
+
 /**
  * Build a tree from a seed value
  *
@@ -74,6 +124,47 @@ export const unfoldTree = <B, A>(b: B, f: (b: B) => readonly [A, ReadonlyArray<B
 export const unfoldForest = <B, A>(bs: ReadonlyArray<B>, f: (b: B) => readonly [A, ReadonlyArray<B>]): Forest<A> =>
   bs.map((b) => unfoldTree(b, f))
 
+/**
+ * Monadic forest builder, in depth-first order
+ *
+ * @category constructors
+ * @since 3.0.0
+ */
+export function unfoldForestM<M extends URIS3>(
+  M: Monad3<M> & Applicative3<M>
+): <R, E, A, B>(
+  bs: ReadonlyArray<B>,
+  f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>
+) => Kind3<M, R, E, Forest<A>>
+export function unfoldForestM<M extends URIS3, E>(
+  M: Monad3C<M, E> & Applicative3C<M, E>
+): <R, A, B>(
+  bs: ReadonlyArray<B>,
+  f: (b: B) => Kind3<M, R, E, readonly [A, ReadonlyArray<B>]>
+) => Kind3<M, R, E, Forest<A>>
+export function unfoldForestM<M extends URIS2>(
+  M: Monad2<M> & Applicative2<M>
+): <R, E, B>(bs: ReadonlyArray<B>, f: (b: B) => Kind2<M, R, readonly [E, ReadonlyArray<B>]>) => Kind2<M, R, Forest<E>>
+export function unfoldForestM<M extends URIS2, E>(
+  M: Monad2C<M, E> & Applicative2C<M, E>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => Kind2<M, E, readonly [A, ReadonlyArray<B>]>) => Kind2<M, E, Forest<A>>
+export function unfoldForestM<M extends URIS>(
+  M: Monad1<M> & Applicative1<M>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => Kind<M, readonly [A, ReadonlyArray<B>]>) => Kind<M, Forest<A>>
+export function unfoldForestM<M>(
+  M: Monad_<M> & Applicative_<M>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) => HKT<M, Forest<A>>
+export function unfoldForestM<M>(
+  M: Monad_<M> & Applicative_<M>
+): <A, B>(bs: ReadonlyArray<B>, f: (b: B) => HKT<M, readonly [A, ReadonlyArray<B>]>) => HKT<M, Forest<A>> {
+  const traverseM = RA.traverse(M)
+  return (bs, f) =>
+    pipe(
+      bs,
+      traverseM((b) => unfoldTreeM(M)(b, f))
+    )
+}
+
 // -------------------------------------------------------------------------------------
 // destructors
 // -------------------------------------------------------------------------------------


Test patch:
diff --git a/test/Tree.ts b/test/Tree.ts
index ef8ca382..5db0f907 100644
--- a/test/Tree.ts
+++ b/test/Tree.ts
@@ -5,6 +5,7 @@ import * as O from '../src/Option'
 import * as _ from '../src/Tree'
 import * as U from './util'
 import * as N from '../src/number'
+import * as I from '../src/Identity'
 
 describe('Tree', () => {
   // -------------------------------------------------------------------------------------
@@ -143,6 +144,12 @@ describe('Tree', () => {
     )
   })
 
+  it('unfoldTreeM', () => {
+    const fa = _.unfoldTreeM({ ...I.Monad, ...I.Applicative })(1, (b) => [b, b < 3 ? [b + 1, b + 2] : []])
+    const expected = _.make(1, [_.make(2, [_.make(3), _.make(4)]), _.make(3)])
+    U.deepStrictEqual(fa, expected)
+  })
+
   // -------------------------------------------------------------------------------------
   // utils
   // -------------------------------------------------------------------------------------