Repository: gcanti/fp-ts (ts)

Issue:
add Traced comonad
Reference implementation: https://github.com/purescript/purescript-transformers/blob/master/src/Control/Comonad/Traced/Trans.purs

Blog post: [COMONADIC BUILDERS](https://chshersh.github.io/posts/2019-03-25-comonadic-builders)

Pull request description:
New Feature: add Traced comonad, closes #798

Patch:
diff --git a/LICENSE b/LICENSE
index 1322a741..e58b2fd6 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,6 +1,6 @@
 MIT License
 
-Copyright (c) 2017-2019 Giulio Canti
+Copyright (c) 2017-present Giulio Canti
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal
diff --git a/docs/modules/Traced.ts.md b/docs/modules/Traced.ts.md
new file mode 100644
index 00000000..7f61235a
--- /dev/null
+++ b/docs/modules/Traced.ts.md
@@ -0,0 +1,127 @@
+---
+title: Traced.ts
+nav_order: 88
+parent: Modules
+---
+
+---
+
+<h2 class="text-delta">Table of contents</h2>
+
+- [URI (type alias)](#uri-type-alias)
+- [Traced (class)](#traced-class)
+  - [map (method)](#map-method)
+- [URI (constant)](#uri-constant)
+- [traced (constant)](#traced-constant)
+- [censor (function)](#censor-function)
+- [getComonad (function)](#getcomonad-function)
+- [listen (function)](#listen-function)
+- [listens (function)](#listens-function)
+- [tracks (function)](#tracks-function)
+
+---
+
+# URI (type alias)
+
+**Signature**
+
+```ts
+export type URI = typeof URI
+```
+
+# Traced (class)
+
+**Signature**
+
+```ts
+export class Traced<P, A> {
+  constructor(readonly run: (p: P) => A) { ... }
+  ...
+}
+```
+
+Added in v1.16.0
+
+## map (method)
+
+**Signature**
+
+```ts
+map<B>(f: (a: A) => B): Traced<P, B> { ... }
+```
+
+# URI (constant)
+
+**Signature**
+
+```ts
+export const URI = ...
+```
+
+# traced (constant)
+
+**Signature**
+
+```ts
+export const traced: Functor2<URI> = ...
+```
+
+Added in v1.16.0
+
+# censor (function)
+
+Apply a function to the current position
+
+**Signature**
+
+```ts
+export const censor = <P, A>(wa: Traced<P, A>, f: (p: P) => P): Traced<P, A> => ...
+```
+
+Added in v1.16.0
+
+# getComonad (function)
+
+**Signature**
+
+```ts
+export function getComonad<P>(monoid: Monoid<P>): Comonad2C<URI, P> { ... }
+```
+
+Added in v1.16.0
+
+# listen (function)
+
+Get the current position
+
+**Signature**
+
+```ts
+export const listen = <P, A>(wa: Traced<P, A>): Traced<P, [A, P]> => ...
+```
+
+Added in v1.16.0
+
+# listens (function)
+
+Get a value which depends on the current position
+
+**Signature**
+
+```ts
+export const listens = <P, A, B>(wa: Traced<P, A>, f: (p: P) => B): Traced<P, [A, B]> => ...
+```
+
+Added in v1.16.0
+
+# tracks (function)
+
+Extracts a value at a relative position which depends on the current value.
+
+**Signature**
+
+```ts
+export const tracks = <P, A>(M: Monoid<P>, f: (a: A) => P) => (wa: Traced<P, A>): A => ...
+```
+
+Added in v1.16.0
diff --git a/docs/modules/Traversable.ts.md b/docs/modules/Traversable.ts.md
index b4bc740c..074dcf56 100644
--- a/docs/modules/Traversable.ts.md
+++ b/docs/modules/Traversable.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Traversable.ts
-nav_order: 88
+nav_order: 89
 parent: Modules
 ---
 
diff --git a/docs/modules/Traversable2v.ts.md b/docs/modules/Traversable2v.ts.md
index 1bdc1534..2ce34ec8 100644
--- a/docs/modules/Traversable2v.ts.md
+++ b/docs/modules/Traversable2v.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Traversable2v.ts
-nav_order: 89
+nav_order: 90
 parent: Modules
 ---
 
diff --git a/docs/modules/TraversableWithIndex.ts.md b/docs/modules/TraversableWithIndex.ts.md
index 4cf80fb3..23adcd59 100644
--- a/docs/modules/TraversableWithIndex.ts.md
+++ b/docs/modules/TraversableWithIndex.ts.md
@@ -1,6 +1,6 @@
 ---
 title: TraversableWithIndex.ts
-nav_order: 90
+nav_order: 91
 parent: Modules
 ---
 
diff --git a/docs/modules/Tree.ts.md b/docs/modules/Tree.ts.md
index cd25ae3e..7f41e624 100644
--- a/docs/modules/Tree.ts.md
+++ b/docs/modules/Tree.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Tree.ts
-nav_order: 91
+nav_order: 92
 parent: Modules
 ---
 
diff --git a/docs/modules/Tuple.ts.md b/docs/modules/Tuple.ts.md
index d0117d66..1d09f022 100644
--- a/docs/modules/Tuple.ts.md
+++ b/docs/modules/Tuple.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Tuple.ts
-nav_order: 92
+nav_order: 93
 parent: Modules
 ---
 
diff --git a/docs/modules/Unfoldable.ts.md b/docs/modules/Unfoldable.ts.md
index 5c5fc0f0..0f807ce4 100644
--- a/docs/modules/Unfoldable.ts.md
+++ b/docs/modules/Unfoldable.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Unfoldable.ts
-nav_order: 93
+nav_order: 94
 parent: Modules
 ---
 
diff --git a/docs/modules/Validation.ts.md b/docs/modules/Validation.ts.md
index ff3e0fbe..9c067e58 100644
--- a/docs/modules/Validation.ts.md
+++ b/docs/modules/Validation.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Validation.ts
-nav_order: 94
+nav_order: 95
 parent: Modules
 ---
 
diff --git a/docs/modules/Witherable.ts.md b/docs/modules/Witherable.ts.md
index 661b9515..49aa8af4 100644
--- a/docs/modules/Witherable.ts.md
+++ b/docs/modules/Witherable.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Witherable.ts
-nav_order: 95
+nav_order: 96
 parent: Modules
 ---
 
diff --git a/docs/modules/Writer.ts.md b/docs/modules/Writer.ts.md
index 6439aebc..cca2e9a8 100644
--- a/docs/modules/Writer.ts.md
+++ b/docs/modules/Writer.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Writer.ts
-nav_order: 96
+nav_order: 97
 parent: Modules
 ---
 
diff --git a/docs/modules/Zipper.ts.md b/docs/modules/Zipper.ts.md
index 5cb5104d..69508302 100644
--- a/docs/modules/Zipper.ts.md
+++ b/docs/modules/Zipper.ts.md
@@ -1,6 +1,6 @@
 ---
 title: Zipper.ts
-nav_order: 97
+nav_order: 98
 parent: Modules
 ---
 
diff --git a/docs/modules/index.ts.md b/docs/modules/index.ts.md
index 6929e82a..bac2213a 100644
--- a/docs/modules/index.ts.md
+++ b/docs/modules/index.ts.md
@@ -94,6 +94,7 @@ parent: Modules
 - [taskEither (export)](#taskeither-export)
 - [these (export)](#these-export)
 - [trace (export)](#trace-export)
+- [traced (export)](#traced-export)
 - [traversable (export)](#traversable-export)
 - [traversable2v (export)](#traversable2v-export)
 - [traversableWithIndex (export)](#traversablewithindex-export)
@@ -795,6 +796,14 @@ export { these }
 export { trace }
 ```
 
+# traced (export)
+
+**Signature**
+
+```ts
+export { traced }
+```
+
 # traversable (export)
 
 **Signature**
diff --git a/src/Traced.ts b/src/Traced.ts
new file mode 100644
index 00000000..5e16d644
--- /dev/null
+++ b/src/Traced.ts
@@ -0,0 +1,92 @@
+import { Comonad2C } from './Comonad'
+import { Monoid } from './Monoid'
+import { Functor2 } from './Functor'
+import { phantom, tuple } from './function'
+
+declare module './HKT' {
+  interface URI2HKT2<L, A> {
+    Traced: Traced<L, A>
+  }
+}
+
+export const URI = 'Traced'
+
+export type URI = typeof URI
+
+/**
+ * @since 1.16.0
+ */
+export class Traced<P, A> {
+  readonly _A!: A
+  readonly _L!: P
+  readonly _URI!: URI
+  constructor(readonly run: (p: P) => A) {}
+  map<B>(f: (a: A) => B): Traced<P, B> {
+    return new Traced((p: P) => f(this.run(p)))
+  }
+}
+
+/**
+ * Extracts a value at a relative position which depends on the current value.
+ * @since 1.16.0
+ */
+export const tracks = <P, A>(M: Monoid<P>, f: (a: A) => P) => (wa: Traced<P, A>): A => {
+  return wa.run(f(wa.run(M.empty)))
+}
+
+/**
+ * Get the current position
+ * @since 1.16.0
+ */
+export const listen = <P, A>(wa: Traced<P, A>): Traced<P, [A, P]> => {
+  return new Traced(e => tuple(wa.run(e), e))
+}
+
+/**
+ * Get a value which depends on the current position
+ * @since 1.16.0
+ */
+export const listens = <P, A, B>(wa: Traced<P, A>, f: (p: P) => B): Traced<P, [A, B]> => {
+  return new Traced(e => tuple(wa.run(e), f(e)))
+}
+
+/**
+ * Apply a function to the current position
+ * @since 1.16.0
+ */
+export const censor = <P, A>(wa: Traced<P, A>, f: (p: P) => P): Traced<P, A> => {
+  return new Traced(e => wa.run(f(e)))
+}
+
+/**
+ * @since 1.16.0
+ */
+export function getComonad<P>(monoid: Monoid<P>): Comonad2C<URI, P> {
+  function extend<A, B>(wa: Traced<P, A>, f: (wa: Traced<P, A>) => B): Traced<P, B> {
+    return new Traced((p1: P) => f(new Traced((p2: P) => wa.run(monoid.concat(p1, p2)))))
+  }
+
+  function extract<A>(wa: Traced<P, A>): A {
+    return wa.run(monoid.empty)
+  }
+
+  return {
+    URI,
+    _L: phantom,
+    map,
+    extend,
+    extract
+  }
+}
+
+function map<P, A, B>(wa: Traced<P, A>, f: (a: A) => B): Traced<P, B> {
+  return wa.map(f)
+}
+
+/**
+ * @since 1.16.0
+ */
+export const traced: Functor2<URI> = {
+  URI,
+  map
+}
diff --git a/src/index.ts b/src/index.ts
index e148ab73..5345b4e4 100644
--- a/src/index.ts
+++ b/src/index.ts
@@ -168,6 +168,8 @@ import * as these from './These'
 export { these }
 import * as trace from './Trace'
 export { trace }
+import * as traced from './Traced'
+export { traced }
 import * as traversable from './Traversable'
 export { traversable }
 import * as traversable2v from './Traversable2v'


Test patch:
diff --git a/test/Traced.ts b/test/Traced.ts
new file mode 100644
index 00000000..6bca54fe
--- /dev/null
+++ b/test/Traced.ts
@@ -0,0 +1,132 @@
+import * as assert from 'assert'
+import { getStructMonoid, monoidAny, Monoid } from '../src/Monoid'
+import { Traced, traced, getComonad, tracks, listen, listens, censor } from '../src/Traced'
+
+// Adapted from https://chshersh.github.io/posts/2019-03-25-comonadic-builders
+
+interface Settings {
+  settingsHasLibrary: boolean
+  settingsGitHub: boolean
+  settingsTravis: boolean
+}
+
+const M: Monoid<Settings> = getStructMonoid({
+  settingsHasLibrary: monoidAny,
+  settingsGitHub: monoidAny,
+  settingsTravis: monoidAny
+})
+
+const C = getComonad(M)
+
+interface Project {
+  projectName: string
+  projectHasLibrary: boolean
+  projectGitHub: boolean
+  projectTravis: boolean
+}
+
+interface ProjectBuilder extends Traced<Settings, Project> {}
+
+const buildProject = (projectName: string): ProjectBuilder =>
+  new Traced(settings => ({
+    projectName,
+    projectHasLibrary: settings.settingsHasLibrary,
+    projectGitHub: settings.settingsGitHub,
+    projectTravis: settings.settingsTravis
+  }))
+
+const hasLibraryB = (wa: ProjectBuilder): Project => {
+  const p = { ...M.empty, settingsHasLibrary: true }
+  return wa.run(p)
+}
+
+const gitHubB = (wa: ProjectBuilder): Project => {
+  const p = { ...M.empty, settingsGitHub: true }
+  return wa.run(p)
+}
+
+const getProjectName = (project: Project): string => project.projectName
+
+describe('Traced', () => {
+  it('map', () => {
+    const wa = buildProject('myproject')
+    assert.deepStrictEqual(traced.map(wa, getProjectName).run(M.empty), 'myproject')
+  })
+
+  it('getComonad', () => {
+    const wa = buildProject('myproject')
+    assert.deepStrictEqual(C.extract(wa), {
+      projectName: 'myproject',
+      projectHasLibrary: false,
+      projectGitHub: false,
+      projectTravis: false
+    })
+    assert.deepStrictEqual(C.extract(C.extend(wa, hasLibraryB)), {
+      projectName: 'myproject',
+      projectHasLibrary: true,
+      projectGitHub: false,
+      projectTravis: false
+    })
+  })
+
+  it('tracks', () => {
+    const travisB = tracks(M, (project: Project): Settings => ({ ...M.empty, settingsTravis: project.projectGitHub }))
+    assert.deepStrictEqual(C.extract(C.extend(buildProject('travis'), travisB)), {
+      projectName: 'travis',
+      projectHasLibrary: false,
+      projectGitHub: false,
+      projectTravis: false
+    })
+    assert.deepStrictEqual(C.extract(C.extend(C.extend(buildProject('github-travis'), gitHubB), travisB)), {
+      projectName: 'github-travis',
+      projectHasLibrary: false,
+      projectGitHub: true,
+      projectTravis: true
+    })
+  })
+
+  it('listen', () => {
+    assert.deepStrictEqual(C.extract(listen(buildProject('myproject'))), [
+      {
+        projectName: 'myproject',
+        projectHasLibrary: false,
+        projectGitHub: false,
+        projectTravis: false
+      },
+      {
+        settingsHasLibrary: false,
+        settingsGitHub: false,
+        settingsTravis: false
+      }
+    ])
+  })
+
+  it('listens', () => {
+    assert.deepStrictEqual(C.extract(listens(buildProject('myproject'), settings => settings.settingsTravis)), [
+      {
+        projectName: 'myproject',
+        projectHasLibrary: false,
+        projectGitHub: false,
+        projectTravis: false
+      },
+      false
+    ])
+  })
+
+  it('censor', () => {
+    assert.deepStrictEqual(
+      C.extract(
+        censor(buildProject('myproject'), settings => ({
+          ...settings,
+          settingsHasLibrary: !settings.settingsHasLibrary
+        }))
+      ),
+      {
+        projectName: 'myproject',
+        projectHasLibrary: true,
+        projectGitHub: false,
+        projectTravis: false
+      }
+    )
+  })
+})