Repository: gcanti/fp-ts
Pull request #548 (2018-08-26 13:44:33)

New Feature: add getMeetMonoid, getJoinMonoid


Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index d084f6e0..891b07b5 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -14,6 +14,11 @@
 **Note**: Gaps between patch versions are faulty/broken releases. **Note**: A feature tagged as Experimental is in a
 high state of flux, you're at risk of it changing without notice.
 
+# 1.8.1
+
+- **Bug Fix**
+  - add module augmentation to `Free`, https://github.com/gcanti/fp-ts/pull/559 (@gcanti)
+
 # 1.8.0
 
 - **New Feature**
diff --git a/README.md b/README.md
index 1f2be552..1b679828 100644
--- a/README.md
+++ b/README.md
@@ -57,6 +57,7 @@ The stable version is tested against TypeScript 3.0.1, but should run with TypeS
 # Documentation
 
 - [API Reference](docs/index.md)
+- [`fp-ts` for `PureScript`ers / `Haskell`ers](fp-ts-for-purescripters.md)
 
 ## Internals
 
diff --git a/docs/Array.md b/docs/Array.md
index b7753d79..1e32203b 100644
--- a/docs/Array.md
+++ b/docs/Array.md
@@ -7,6 +7,22 @@ title: Module Array
 
 ## Constants
 
+### empty
+
+_constant_
+
+_since 1.9.0_
+
+_Signature_
+
+```ts
+empty: Array<never>
+```
+
+_Description_
+
+An empty array
+
 ### getSetoid
 
 _constant_
diff --git a/docs/function.md b/docs/function.md
index a4f28927..f4bc2874 100644
--- a/docs/function.md
+++ b/docs/function.md
@@ -105,6 +105,23 @@ _Description_
 
 A thunk that returns always `false`
 
+### constIdentity
+
+_function_
+
+_since 1.5.0_
+
+_Signature_
+
+```ts
+(): (<A>(a: A) => A)
+```
+
+_Description_
+
+A thunk that returns always the `identity` function.
+For use with `applySecond` methods.
+
 ### constNull
 
 _function_
@@ -177,6 +194,18 @@ _Signature_
 curry(f: Function)
 ```
 
+### decrement
+
+_function_
+
+_since 1.9.0_
+
+_Signature_
+
+```ts
+(n: number): number
+```
+
 ### flip
 
 _function_
@@ -205,6 +234,18 @@ _Signature_
 <A>(a: A): A
 ```
 
+### increment
+
+_function_
+
+_since 1.9.0_
+
+_Signature_
+
+```ts
+(n: number): number
+```
+
 ### not
 
 _function_
diff --git a/examples/mtl.ts b/examples/mtl.ts
index 01d92402..5bfaeab6 100644
--- a/examples/mtl.ts
+++ b/examples/mtl.ts
@@ -3,7 +3,7 @@ import { flatten } from '../src/Chain'
 import { HKT, Type, Type3, URIS, URIS3 } from '../src/HKT'
 import { IO, URI as IOURI, io } from '../src/IO'
 import { Monad, Monad1, Monad3 } from '../src/Monad'
-import { Task, URI as TaskURI, task } from '../src/Task'
+import { URI as TaskURI, task, delay } from '../src/Task'
 import { URI as ReaderTaskEitherURI, right, readerTaskEither } from '../src/ReaderTaskEither'
 
 // Adapted from https://tech.iheart.com/why-fp-its-the-composition-f585d17b01d3
@@ -72,29 +72,18 @@ true
 */
 
 const now = Date.now()
-const delay = <A>(a: A) => (n: number): Task<A> =>
-  new Task(
-    () =>
-      new Promise(resolve => {
-        setTimeout(() => {
-          // tslint:disable-next-line:no-console
-          console.log(`${a} after ${(Date.now() - now) / 1000}`)
-          resolve(a)
-        }, n)
-      })
-  )
 
 const monadUserTask: MonadUser1<TaskURI> = {
-  validateUser: token => delay(`string(${token})`)(1000),
-  facebookToken: uid => delay(`FBToken(${uid})`)(500)
+  validateUser: token => delay(1000, `string(${token})`),
+  facebookToken: uid => delay(500, `FBToken(${uid})`)
 }
 
 const monadFBTask: MonadFB1<TaskURI> = {
-  findPost: url => delay(`FBPost(${url})`)(2000),
+  findPost: url => delay(2000, `FBPost(${url})`),
   sendLike: token => (post: string) => {
     // tslint:disable-next-line:no-console
     console.log(`sending like with fbToken "${token}" and post "${post}"`)
-    return delay(true)(1000)
+    return delay(1000, true)
   }
 }
 
diff --git a/fp-ts-for-purescripters.md b/fp-ts-for-purescripters.md
new file mode 100644
index 00000000..db1245ca
--- /dev/null
+++ b/fp-ts-for-purescripters.md
@@ -0,0 +1,221 @@
+---
+title: `fp-ts` for `PureScript`ers / `Haskell`ers
+---
+
+# Do notation
+
+PureScript
+
+```purescript
+do
+  print "foo"
+  print "bar"
+  x <- readLine
+  print x
+```
+
+TypeScript
+
+```ts
+// print: (s: string) => Task<void>
+// readLine: Task<string>
+
+print('foo')
+  .chain(_ => print('bar'))
+  .chain(_ => readLine)
+  .chain(print)
+```
+
+# Data
+
+PureScript
+
+```purescript
+--   ↓-- type
+data Foo = Bar String | Baz Boolean
+--         ↑------------↑-- constructors
+```
+
+TypeScript
+
+```ts
+interface Bar { type: 'Bar'; value: string }
+interface Baz { type: 'Baz'; value: boolean }
+// type
+type Foo = Bar | Baz
+// constructors
+const Bar = (value: string): Foo => ({ type: 'Bar', value })
+const Baz = (value: boolean): Foo => ({ type: 'Baz', value })
+```
+
+# Polymorphic data
+
+PureScript
+
+```purescript
+data Option a = None | Some a
+```
+
+TypeScript
+
+```ts
+declare module 'fp-ts/lib/HKT' {
+  interface URI2HKT<A> {
+    Option: Option<A>
+  }
+}
+
+const URI = 'Option'
+
+type URI = typeof URI
+
+class None<A> {
+  static value: Option<never> = new None()
+  readonly _tag: 'None' = 'None'
+  readonly _A!: A
+  readonly _URI!: URI
+  private constructor() {}
+}
+
+class Some<A> {
+  readonly _tag: 'Some' = 'Some'
+  readonly _A!: A
+  readonly _URI!: URI
+  constructor(readonly value: A) {}
+}
+
+type Option<A> = None<A> | Some<A>
+
+const none = None.value
+
+const some = <A>(a: A): Option<A> => new Some(a)
+```
+
+# Pattern matching
+
+PureScript
+
+```purescript
+maybe :: forall a b. b -> (a -> b) -> Option a -> b
+maybe b _ None = b
+maybe _ f (Some a) = f a
+```
+
+TypeScript
+
+```ts
+const maybe = <A, B>(whenNone: B, whenSome: (a: A) => B, fa: Option<A>): B => {
+  switch (fa.type) {
+    case 'None' :
+      return whenNone
+    case 'Some' :
+      return whenSome(fa.value)
+  }
+}
+```
+
+# Type classes
+
+PureScript
+
+```purescript
+class Functor f where
+  map :: forall a b. (a -> b) -> f a -> f b
+```
+
+TypeScript
+
+```ts
+export interface Functor<F> {
+  readonly URI: F
+  readonly map: <A, B>(fa: HKT<F, A>, f: (a: A) => B) => HKT<F, B>
+}
+
+export interface Functor1<F extends URIS> {
+  readonly URI: F
+  readonly map: <A, B>(fa: Type<F, A>, f: (a: A) => B) => Type<F, B>
+}
+
+export interface Functor2<F extends URIS2> {
+  readonly URI: F
+  readonly map: <L, A, B>(fa: Type2<F, L, A>, f: (a: A) => B) => Type2<F, L, B>
+}
+
+export interface Functor3<F extends URIS3> {
+  readonly URI: F
+  readonly map: <U, L, A, B>(fa: Type3<F, U, L, A>, f: (a: A) => B) => Type3<F, U, L, B>
+}
+
+export interface Functor2C<F extends URIS2, L> {
+  readonly URI: F
+  readonly _L: L
+  readonly map: <A, B>(fa: Type2<F, L, A>, f: (a: A) => B) => Type2<F, L, B>
+}
+
+export interface Functor3C<F extends URIS3, U, L> {
+  readonly URI: F
+  readonly _L: L
+  readonly _U: U
+  readonly map: <A, B>(fa: Type3<F, U, L, A>, f: (a: A) => B) => Type3<F, U, L, B>
+}
+```
+
+# Instances
+
+PureScript
+
+```purescript
+instance functorOption :: Functor Option where
+  map fn (Some x) = Some (fn x)
+  map _  _        = None
+```
+
+TypeScript
+
+```ts
+const functorOption: Functor1<'Option'> = {
+  map: (fa, f) => maybe(none, a => some(f(fa.value)), fa)
+}
+```
+
+# Type constraints
+
+PureScript
+
+```purescript
+instance semigroupOption :: Semigroup a => Semigroup (Option a) where
+  append None y = y
+  append x None = x
+  append (Some x) (Some y) = Some (x <> y)
+
+instance monoidOption :: Semigroup a => Monoid (Option a) where
+  mempty = None
+```
+
+TypeScript
+
+```ts
+//                    ↓ the constraint is implemented as an additional parameter
+const getMonoid = <A>(S: Semigroup<A>): Monoid<Option<A>> => {
+  return {
+    concat: (x, y) => {
+      if (x._tag === 'Some' && y._tag === 'Some') {
+        return some(S.concat(x.value, y.value))
+      } else if (x._tag === 'Some') {
+        return y
+      } else {
+        return x
+      }
+    },
+    empty: none
+  }
+}
+```
+
+# Newtypes
+
+See [newtype-ts](https://github.com/gcanti/newtype-ts)
+
+# Functional optics
+
+See [monocle-ts](https://github.com/gcanti/monocle-ts)
diff --git a/package-lock.json b/package-lock.json
index be4a6a9e..95b3a2e2 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "fp-ts",
-  "version": "1.7.1",
+  "version": "1.8.1",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
@@ -6376,9 +6376,9 @@
       }
     },
     "typescript": {
-      "version": "3.0.1",
-      "resolved": "https://registry.npmjs.org/typescript/-/typescript-3.0.1.tgz",
-      "integrity": "sha512-zQIMOmC+372pC/CCVLqnQ0zSBiY7HHodU7mpQdjiZddek4GMj31I3dUJ7gAs9o65X7mnRma6OokOkc6f9jjfBg==",
+      "version": "3.0.3",
+      "resolved": "https://registry.npmjs.org/typescript/-/typescript-3.0.3.tgz",
+      "integrity": "sha512-kk80vLW9iGtjMnIv11qyxLqZm20UklzuR2tL0QAnDIygIUIemcZMxlMWudl9OOt76H3ntVzcTiddQ1/pAAJMYg==",
       "dev": true
     },
     "typings-checker": {
diff --git a/package.json b/package.json
index 3b21dd1a..5623327f 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "fp-ts",
-  "version": "1.8.0",
+  "version": "1.8.1",
   "description": "Functional programming in TypeScript",
   "files": [
     "lib"
@@ -17,6 +17,7 @@
     "test": "npm run lint && npm run prettier && npm run typings && npm run jest",
     "clean": "rimraf lib/*",
     "build": "npm run clean && tsc",
+    "prepublish": "npm run build",
     "docs": "rimraf docs/*.md && ts-node docs-generator/main.ts"
   },
   "repository": {
@@ -45,7 +46,7 @@
     "ts-simple-ast": "0.74.0",
     "tslint": "5.9.1",
     "tslint-config-standard": "7.0.0",
-    "typescript": "^3.0.1",
+    "typescript": "^3.0.3",
     "typings-checker": "2.0.0"
   },
   "tags": [
diff --git a/src/Array.ts b/src/Array.ts
index 14ef6417..99d5d633 100644
--- a/src/Array.ts
+++ b/src/Array.ts
@@ -23,7 +23,9 @@ import { Witherable1 } from './Witherable'
 
 declare global {
   interface Array<T> {
+    /** phantom property added by `fp-ts` */
     _URI: URI
+    /** phantom property added by `fp-ts` */
     _A: T
   }
 }
@@ -45,7 +47,7 @@ export type URI = typeof URI
 export const getMonoid = <A = never>(): Monoid<Array<A>> => {
   return {
     concat,
-    empty: []
+    empty
   }
 }
 
@@ -158,7 +160,15 @@ export function traverse<F>(F: Applicative<F>): <A, B>(ta: Array<A>, f: (a: A) =
   return (ta, f) => reduce(ta, F.of(zero()), (fab, a) => liftedSnoc(fab)(f(a)))
 }
 
-const zero = <A>(): Array<A> => []
+/**
+ * An empty array
+ *
+ * @constant
+ * @since 1.9.0
+ */
+export const empty: Array<never> = []
+
+const zero = <A>(): Array<A> => empty
 
 const alt = concat
 
diff --git a/src/Foldable.ts b/src/Foldable.ts
index ed118c92..749dfda8 100644
--- a/src/Foldable.ts
+++ b/src/Foldable.ts
@@ -489,7 +489,8 @@ export function toArray<F>(F: Foldable<F>): <A>(fa: HKT<F, A>) => Array<A>
  * @since 1.0.0
  */
 export function toArray<F>(F: Foldable<F>): <A>(fa: HKT<F, A>) => Array<A> {
-  return fa => foldMap(F, unsafeMonoidArray)(fa, a => [a])
+  const foldMapF = foldMap(F, unsafeMonoidArray)
+  return fa => foldMapF(fa, a => [a])
 }
 
 /**
diff --git a/src/Free.ts b/src/Free.ts
index c88bd2b2..c19a0a54 100644
--- a/src/Free.ts
+++ b/src/Free.ts
@@ -9,6 +9,12 @@ export const URI = 'Free'
 
 export type URI = typeof URI
 
+declare module './HKT' {
+  interface URI2HKT2<L, A> {
+    Free: Free<L, A>
+  }
+}
+
 /**
  * @data
  * @constructor Pure
diff --git a/src/Monoid.ts b/src/Monoid.ts
index 6d552a3f..3f51917d 100644
--- a/src/Monoid.ts
+++ b/src/Monoid.ts
@@ -1,12 +1,16 @@
+import { Bounded } from './Bounded'
+import { compose, Endomorphism, identity } from './function'
 import {
-  Semigroup,
   fold as foldSemigroup,
   getArraySemigroup,
   getDictionarySemigroup,
   getDualSemigroup,
   getFunctionSemigroup,
+  getJoinSemigroup,
+  getMeetSemigroup,
   getProductSemigroup,
   getRecordSemigroup,
+  Semigroup,
   semigroupAll,
   semigroupAny,
   semigroupProduct,
@@ -14,7 +18,6 @@ import {
   semigroupSum,
   semigroupVoid
 } from './Semigroup'
-import { Endomorphism, compose, identity } from './function'
 
 /**
  * @typeclass
@@ -187,3 +190,25 @@ export const getRecordMonoid = <O extends { [key: string]: any }>(
     empty
   }
 }
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getMeetMonoid = <A>(B: Bounded<A>): Monoid<A> => {
+  return {
+    ...getMeetSemigroup(B),
+    empty: B.top
+  }
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getJoinMonoid = <A>(B: Bounded<A>): Monoid<A> => {
+  return {
+    ...getJoinSemigroup(B),
+    empty: B.bottom
+  }
+}
diff --git a/src/TaskEither.ts b/src/TaskEither.ts
index be34bc27..34a2f08c 100644
--- a/src/TaskEither.ts
+++ b/src/TaskEither.ts
@@ -1,12 +1,21 @@
 import { Alt2 } from './Alt'
 import { Bifunctor2 } from './Bifunctor'
-import { Either, fromPredicate as eitherFromPredicate, left as eitherLeft, right as eitherRight } from './Either'
+import {
+  Either,
+  fromPredicate as eitherFromPredicate,
+  left as eitherLeft,
+  right as eitherRight,
+  getSemigroup as eitherGetSemigroup,
+  getApplySemigroup as eitherGetApplySemigroup
+} from './Either'
 import * as eitherT from './EitherT'
 import { IO } from './IO'
 import { Monad2 } from './Monad'
-import { Task, fromIO as taskFromIO, task, tryCatch as taskTryCatch } from './Task'
+import { Task, fromIO as taskFromIO, task, tryCatch as taskTryCatch, getSemigroup as taskGetSemigroup } from './Task'
 import { Lazy, constIdentity, constant, Predicate } from './function'
 import { IOEither } from './IOEither'
+import { Semigroup } from './Semigroup'
+import { Monoid } from './Monoid'
 
 declare module './HKT' {
   interface URI2HKT2<L, A> {
@@ -174,6 +183,39 @@ export const fromPredicate = <L, A>(predicate: Predicate<A>, whenFalse: (a: A) =
   return a => fromEither(f(a))
 }
 
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getSemigroup = <L, A>(S: Semigroup<A>): Semigroup<TaskEither<L, A>> => {
+  const S2 = taskGetSemigroup(eitherGetSemigroup<L, A>(S))
+  return {
+    concat: (x, y) => new TaskEither<L, A>(S2.concat(x.value, y.value))
+  }
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getApplySemigroup = <L, A>(S: Semigroup<A>): Semigroup<TaskEither<L, A>> => {
+  const S2 = taskGetSemigroup(eitherGetApplySemigroup<L, A>(S))
+  return {
+    concat: (x, y) => new TaskEither<L, A>(S2.concat(x.value, y.value))
+  }
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getApplyMonoid = <L, A>(M: Monoid<A>): Monoid<TaskEither<L, A>> => {
+  return {
+    ...getApplySemigroup(M),
+    empty: of(M.empty)
+  }
+}
+
 /**
  * @function
  * @since 1.0.0
diff --git a/src/Zipper.ts b/src/Zipper.ts
new file mode 100644
index 00000000..50241624
--- /dev/null
+++ b/src/Zipper.ts
@@ -0,0 +1,276 @@
+import { Semigroup } from './Semigroup'
+import { Monoid } from './Monoid'
+import { Option, none, some } from './Option'
+import { isOutOfBound, snoc, take, drop, array, isEmpty, cons } from './Array'
+import { Applicative1, Applicative } from './Applicative'
+import { NonEmptyArray } from './NonEmptyArray'
+import { Foldable1 } from './Foldable'
+import { HKT } from './HKT'
+import { Traversable1 } from './Traversable'
+import { Comonad1 } from './Comonad'
+import { toString, decrement, increment } from './function'
+
+/*
+  Adapted from
+
+  - https://github.com/DavidHarrison/purescript-list-zipper
+  - https://github.com/thunklife/purescript-zipper
+  - https://github.com/scalaz/scalaz/blob/series/7.3.x/core/src/main/scala/scalaz/Zipper.scala
+*/
+
+declare module './HKT' {
+  interface URI2HKT<A> {
+    Zipper: Zipper<A>
+  }
+}
+
+export const URI = 'Zipper'
+
+export type URI = typeof URI
+
+/**
+ * Provides a pointed array, which is a non-empty zipper-like array structure that tracks an index (focus)
+ * position in an array. Focus can be moved forward and backwards through the array.
+ *
+ * @data
+ * @constructor Zipper
+ * @since 1.9.0
+ * @example
+ *
+ * The array `[1, 2, 3, 4]` with focus on `3` is represented by `new Zipper([1, 2], 3, [4])`
+ */
+export class Zipper<A> {
+  readonly _A!: A
+  readonly _URI!: URI
+  length: number
+  constructor(readonly lefts: Array<A>, readonly focus: A, readonly rights: Array<A>) {
+    this.length = lefts.length + 1 + rights.length
+  }
+  /**
+   * Update the focus in this zipper.
+   * @since 1.9.0
+   */
+  update(a: A): Zipper<A> {
+    return new Zipper(this.lefts, a, this.rights)
+  }
+  /**
+   * Apply `f` to the focus and update with the result.
+   * @since 1.9.0
+   */
+  modify(f: (a: A) => A): Zipper<A> {
+    return this.update(f(this.focus))
+  }
+  /**
+   * @since 1.9.0
+   */
+  toArray(): Array<A> {
+    return snoc(this.lefts, this.focus).concat(this.rights)
+  }
+  /**
+   * @since 1.9.0
+   */
+  isOutOfBound(index: number): boolean {
+    return index < 0 || index >= this.length
+  }
+  /**
+   * Moves focus in the zipper, or `None` if there is no such element.
+   * @since 1.9.0
+   */
+  move(f: (currentIndex: number) => number): Option<Zipper<A>> {
+    const newIndex = f(this.lefts.length)
+    if (this.isOutOfBound(newIndex)) {
+      return none
+    } else {
+      return fromArray(this.toArray(), newIndex)
+    }
+  }
+  /**
+   * @since 1.9.0
+   */
+  up(): Option<Zipper<A>> {
+    return this.move(decrement)
+  }
+  /**
+   * @since 1.9.0
+   */
+  down(): Option<Zipper<A>> {
+    return this.move(increment)
+  }
+  /**
+   * Moves focus to the start of the zipper.
+   * @since 1.9.0
+   */
+  start(): Zipper<A> {
+    if (isEmpty(this.lefts)) {
+      return this
+    } else {
+      return new Zipper(empty, this.lefts[0], snoc(drop(1, this.lefts), this.focus).concat(this.rights))
+    }
+  }
+  /**
+   * Moves focus to the end of the zipper.
+   * @since 1.9.0
+   */
+  end(): Zipper<A> {
+    const len = this.rights.length
+    if (len === 0) {
+      return this
+    } else {
+      return new Zipper(snoc(this.lefts, this.focus).concat(take(len - 1, this.rights)), this.rights[len - 1], empty)
+    }
+  }
+  /**
+   * Inserts an element to the left of focus and focuses on the new element.
+   * @since 1.9.0
+   */
+  insertLeft(a: A): Zipper<A> {
+    return new Zipper(this.lefts, a, cons(this.focus, this.rights))
+  }
+  /**
+   * Inserts an element to the right of focus and focuses on the new element.
+   * @since 1.9.0
+   */
+  insertRight(a: A): Zipper<A> {
+    return new Zipper(snoc(this.lefts, this.focus), a, this.rights)
+  }
+  /**
+   * Deletes the element at focus and moves the focus to the left. If there is no element on the left,
+   * focus is moved to the right.
+   * @since 1.9.0
+   */
+  deleteLeft(): Option<Zipper<A>> {
+    const len = this.lefts.length
+    return fromArray(this.lefts.concat(this.rights), len > 0 ? len - 1 : 0)
+  }
+  /**
+   * Deletes the element at focus and moves the focus to the right. If there is no element on the right,
+   * focus is moved to the left.
+   * @since 1.9.0
+   */
+
+  deleteRight(): Option<Zipper<A>> {
+    const lenl = this.lefts.length
+    const lenr = this.rights.length
+    return fromArray(this.lefts.concat(this.rights), lenr > 0 ? lenl : lenl - 1)
+  }
+  /**
+   * @since 1.9.0
+   */
+  map<B>(f: (a: A) => B): Zipper<B> {
+    return new Zipper(this.lefts.map(f), f(this.focus), this.rights.map(f))
+  }
+  /**
+   * @since 1.9.0
+   */
+  ap<B>(fab: Zipper<(a: A) => B>): Zipper<B> {
+    return new Zipper(array.ap(fab.lefts, this.lefts), fab.focus(this.focus), array.ap(fab.rights, this.rights))
+  }
+  /**
+   * @since 1.9.0
+   */
+  reduce<B>(b: B, f: (b: B, a: A) => B): B {
+    return this.rights.reduce(f, f(this.lefts.reduce(f, b), this.focus))
+  }
+  inspect(): string {
+    return this.toString()
+  }
+  toString(): string {
+    return `new Zipper(${toString(this.lefts)}, ${toString(this.focus)}, ${toString(this.rights)})`
+  }
+}
+
+const empty = array.zero<never>()
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const fromArray = <A>(as: Array<A>, focusIndex: number = 0): Option<Zipper<A>> => {
+  if (isEmpty(as) || isOutOfBound(focusIndex, as)) {
+    return none
+  } else {
+    return some(new Zipper(take(focusIndex, as), as[focusIndex], drop(focusIndex + 1, as)))
+  }
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const fromNonEmptyArray = <A>(nea: NonEmptyArray<A>): Zipper<A> => {
+  return new Zipper(empty, nea.head, nea.tail)
+}
+
+const map = <A, B>(fa: Zipper<A>, f: (a: A) => B): Zipper<B> => {
+  return fa.map(f)
+}
+
+const of = <A>(a: A): Zipper<A> => {
+  return new Zipper(empty, a, empty)
+}
+
+const ap = <A, B>(fab: Zipper<(a: A) => B>, fa: Zipper<A>): Zipper<B> => {
+  return fa.ap(fab)
+}
+
+const reduce = <A, B>(fa: Zipper<A>, b: B, f: (b: B, a: A) => B): B => {
+  return fa.reduce(b, f)
+}
+
+const traverse = <F>(F: Applicative<F>): (<A, B>(ta: Zipper<A>, f: (a: A) => HKT<F, B>) => HKT<F, Zipper<B>>) => {
+  const traverseF = array.traverse(F)
+  return (ta, f) => {
+    const len = ta.lefts.length
+    return F.map(traverseF(ta.toArray(), f), bs => new Zipper(take(len, bs), bs[len], drop(len + 1, bs)))
+  }
+}
+
+const extract = <A>(fa: Zipper<A>): A => {
+  return fa.focus
+}
+
+const extend = <A, B>(fa: Zipper<A>, f: (fa: Zipper<A>) => B): Zipper<B> => {
+  const lefts = fa.lefts.map((a, i) =>
+    f(new Zipper(take(i, fa.lefts), a, snoc(drop(i + 1, fa.lefts), fa.focus).concat(fa.rights)))
+  )
+  const rights = fa.rights.map((a, i) =>
+    f(new Zipper(snoc(fa.lefts, fa.focus).concat(take(i, fa.rights)), a, drop(i + 1, fa.rights)))
+  )
+  return new Zipper(lefts, f(fa), rights)
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getSemigroup = <A>(S: Semigroup<A>): Semigroup<Zipper<A>> => {
+  return {
+    concat: (x, y) => new Zipper(x.lefts.concat(y.lefts), S.concat(x.focus, y.focus), x.rights.concat(y.rights))
+  }
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const getMonoid = <A>(M: Monoid<A>): Monoid<Zipper<A>> => {
+  return {
+    ...getSemigroup(M),
+    empty: new Zipper(empty, M.empty, empty)
+  }
+}
+
+/**
+ * @instance
+ * @since 1.9.0
+ */
+export const zipper: Applicative1<URI> & Foldable1<URI> & Traversable1<URI> & Comonad1<URI> = {
+  URI,
+  map,
+  of,
+  ap,
+  extend,
+  extract,
+  reduce,
+  traverse
+}
diff --git a/src/function.ts b/src/function.ts
index ed3f9a00..6c78a404 100644
--- a/src/function.ts
+++ b/src/function.ts
@@ -384,6 +384,25 @@ export const phantom: any = undefined
 /**
  * A thunk that returns always the `identity` function.
  * For use with `applySecond` methods.
+ * @function
  * @since 1.5.0
  */
-export const constIdentity = () => identity
+export const constIdentity = (): (<A>(a: A) => A) => {
+  return identity
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const increment = (n: number): number => {
+  return n + 1
+}
+
+/**
+ * @function
+ * @since 1.9.0
+ */
+export const decrement = (n: number): number => {
+  return n - 1
+}
diff --git a/src/index.ts b/src/index.ts
index ebdce352..8a0b93e6 100644
--- a/src/index.ts
+++ b/src/index.ts
@@ -156,3 +156,5 @@ import * as filterable from './Filterable'
 export { filterable }
 import * as witherable from './Witherable'
 export { witherable }
+import * as zipper from './Zipper'
+export { zipper }
diff --git a/tsconfig.json b/tsconfig.json
index 2e115475..d9afa656 100644
--- a/tsconfig.json
+++ b/tsconfig.json
@@ -1,7 +1,6 @@
 {
   "compilerOptions": {
     "outDir": "./lib",
-    "sourceMap": true,
     "declaration": true,
     "target": "es5",
     "module": "commonjs",


Test patch:
diff --git a/test/Array.ts b/test/Array.ts
index 439edc15..a8c22841 100644
--- a/test/Array.ts
+++ b/test/Array.ts
@@ -313,7 +313,7 @@ describe('Array', () => {
   })
 
   it('reduce', () => {
-    assert.deepEqual(array.reduce([1, 2, 3], 0, (acc, a) => acc + a), 6)
+    assert.deepEqual(array.reduce(['a', 'b', 'c'], '', (acc, a) => acc + a), 'abc')
   })
 
   it('fold', () => {
diff --git a/test/Foldable.ts b/test/Foldable.ts
index 2b2edd90..31f1c9bb 100644
--- a/test/Foldable.ts
+++ b/test/Foldable.ts
@@ -25,6 +25,7 @@ import { monoidString } from '../src/Monoid'
 import * as option from '../src/Option'
 import { ordNumber } from '../src/Ord'
 import { setoidNumber } from '../src/Setoid'
+import { StrMap, strmap } from '../src/StrMap'
 
 export const ArrayOptionURI = 'ArrayOption'
 
@@ -33,6 +34,9 @@ export type ArrayOptionURI = typeof ArrayOptionURI
 describe('Foldable', () => {
   it('toArray', () => {
     assert.deepEqual(toArray(array)([1, 2, 3]), [1, 2, 3])
+    assert.deepEqual(toArray(option.option)(option.some(1)), [1])
+    assert.deepEqual(toArray(option.option)(option.none), [])
+    assert.deepEqual(toArray(strmap)(new StrMap({ a: 1, b: 2 })), [1, 2])
   })
 
   it('foldMap', () => {
diff --git a/test/Monoid.ts b/test/Monoid.ts
index 2475f478..7e7e3183 100644
--- a/test/Monoid.ts
+++ b/test/Monoid.ts
@@ -11,9 +11,12 @@ import {
   monoidAny,
   monoidString,
   monoidSum,
-  getProductMonoid
+  getProductMonoid,
+  getMeetMonoid,
+  getJoinMonoid
 } from '../src/Monoid'
 import { semigroupSum } from '../src/Semigroup'
+import { boundedNumber } from '../src/Bounded'
 
 describe('Monoid', () => {
   it('fold', () => {
@@ -84,4 +87,18 @@ describe('Monoid', () => {
     const M = getProductMonoid(monoidString, monoidSum)
     assert.deepEqual(M.empty, ['', 0])
   })
+
+  it('getMeetMonoid', () => {
+    const M = getMeetMonoid(boundedNumber)
+    assert.deepEqual(fold(M)([]), +Infinity)
+    assert.deepEqual(fold(M)([1]), 1)
+    assert.deepEqual(fold(M)([1, -1]), -1)
+  })
+
+  it('getMeetMonoid', () => {
+    const M = getJoinMonoid(boundedNumber)
+    assert.deepEqual(fold(M)([]), -Infinity)
+    assert.deepEqual(fold(M)([1]), 1)
+    assert.deepEqual(fold(M)([1, -1]), 1)
+  })
 })
diff --git a/test/TaskEither.ts b/test/TaskEither.ts
index 42d4b6bc..fae64fa7 100644
--- a/test/TaskEither.ts
+++ b/test/TaskEither.ts
@@ -1,7 +1,7 @@
 import * as assert from 'assert'
 import { left as eitherLeft, right as eitherRight } from '../src/Either'
 import { IO } from '../src/IO'
-import { Task, task } from '../src/Task'
+import { Task, task, delay } from '../src/Task'
 import {
   TaskEither,
   fromIO,
@@ -12,9 +12,13 @@ import {
   taskify,
   tryCatch,
   fromIOEither,
-  fromPredicate
+  fromPredicate,
+  getApplyMonoid,
+  getSemigroup
 } from '../src/TaskEither'
 import { IOEither } from '../src/IOEither'
+import { monoidString } from '../src/Monoid'
+import { semigroupSum } from '../src/Semigroup'
 
 describe('TaskEither', () => {
   it('ap', () => {
@@ -211,4 +215,47 @@ describe('TaskEither', () => {
       assert.deepEqual(e2, eitherLeft('Invalid number 1'))
     })
   })
+
+  it('getSemigroup', () => {
+    const S = getSemigroup<string, number>(semigroupSum)
+    return Promise.all([
+      S.concat(left(delay(10, 'a')), left(delay(10, 'b')))
+        .run()
+        .then(x => assert.deepEqual(x, eitherLeft('a'))),
+      S.concat(left(delay(10, 'a')), right(delay(10, 2)))
+        .run()
+        .then(x => assert.deepEqual(x, eitherRight(2))),
+      S.concat(right(delay(10, 1)), left(delay(10, 'b')))
+        .run()
+        .then(x => assert.deepEqual(x, eitherRight(1))),
+      S.concat(right(delay(10, 1)), right(delay(10, 2)))
+        .run()
+        .then(x => assert.deepEqual(x, eitherRight(3)))
+    ])
+  })
+
+  describe('getApplyMonoid', () => {
+    const M = getApplyMonoid(monoidString)
+
+    it('concat (right)', () => {
+      return M.concat(right(delay(10, 'a')), right(delay(10, 'b')))
+        .run()
+        .then(x => assert.deepEqual(x, eitherRight('ab')))
+    })
+    it('concat (left)', () => {
+      return M.concat(right(delay(10, 'a')), left(delay(10, 'b')))
+        .run()
+        .then(x => assert.deepEqual(x, eitherLeft('b')))
+    })
+    it('empty (right)', () => {
+      return M.concat(right(delay(10, 'a')), M.empty)
+        .run()
+        .then(x => assert.deepEqual(x, eitherRight('a')))
+    })
+    it('empty (left)', () => {
+      return M.concat(M.empty, right(delay(10, 'a')))
+        .run()
+        .then(x => assert.deepEqual(x, eitherRight('a')))
+    })
+  })
 })
diff --git a/test/Zipper.ts b/test/Zipper.ts
new file mode 100644
index 00000000..99e7328d
--- /dev/null
+++ b/test/Zipper.ts
@@ -0,0 +1,167 @@
+import * as assert from 'assert'
+import { Zipper, zipper, fromArray, getSemigroup, getMonoid, fromNonEmptyArray } from '../src/Zipper'
+import { none, some, option } from '../src/Option'
+import { semigroupSum } from '../src/Semigroup'
+import { monoidSum } from '../src/Monoid'
+import { NonEmptyArray } from '../src/NonEmptyArray'
+
+const len = (s: string): number => s.length
+const prepend = (a: string) => (s: string): string => a + s
+const append = (a: string) => (s: string): string => s + a
+
+describe('Zipper', () => {
+  it('update', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.deepEqual(fa.update('e'), new Zipper(['a', 'b'], 'e', ['d']))
+  })
+
+  it('modify', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.deepEqual(fa.modify(append('!')), new Zipper(['a', 'b'], 'c!', ['d']))
+  })
+
+  it('toArray', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.deepEqual(fa.toArray(), ['a', 'b', 'c', 'd'])
+  })
+
+  it('isOutOfBound', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.deepEqual(fa.isOutOfBound(-1), true)
+    assert.deepEqual(fa.isOutOfBound(4), true)
+    assert.deepEqual(fa.isOutOfBound(2), false)
+  })
+
+  it('up', () => {
+    assert.deepEqual(new Zipper(['a', 'b'], 'c', ['d']).up(), some(new Zipper(['a'], 'b', ['c', 'd'])))
+    assert.deepEqual(new Zipper([], 'c', ['d']).up(), none)
+  })
+
+  it('down', () => {
+    assert.deepEqual(new Zipper(['a', 'b'], 'c', ['d', 'e']).down(), some(new Zipper(['a', 'b', 'c'], 'd', ['e'])))
+    assert.deepEqual(new Zipper(['a', 'b'], 'c', []).down(), none)
+  })
+
+  it('start', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d', 'e'])
+    assert.deepEqual(fa.start(), new Zipper([], 'a', ['b', 'c', 'd', 'e']))
+    const start = new Zipper([], 1, [2])
+    assert.strictEqual(start.start(), start)
+  })
+
+  it('end', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d', 'e'])
+    assert.deepEqual(fa.end(), new Zipper(['a', 'b', 'c', 'd'], 'e', []))
+    const end = new Zipper([1], 2, [])
+    assert.strictEqual(end.end(), end)
+  })
+
+  it('insertLeft', () => {
+    assert.deepEqual(
+      new Zipper(['a', 'b'], 'c', ['d', 'e']).insertLeft('f'),
+      new Zipper(['a', 'b'], 'f', ['c', 'd', 'e'])
+    )
+  })
+
+  it('insertRight', () => {
+    assert.deepEqual(
+      new Zipper(['a', 'b'], 'c', ['d', 'e']).insertRight('f'),
+      new Zipper(['a', 'b', 'c'], 'f', ['d', 'e'])
+    )
+  })
+
+  it('deleteLeft', () => {
+    assert.deepEqual(new Zipper(['a', 'b'], 'c', ['d', 'e']).deleteLeft(), some(new Zipper(['a'], 'b', ['d', 'e'])))
+    assert.deepEqual(
+      new Zipper(['a', 'b', 'c'], 'd', ['e', 'f']).deleteLeft(),
+      some(new Zipper(['a', 'b'], 'c', ['e', 'f']))
+    )
+    assert.deepEqual(new Zipper([], 'c', ['d', 'e']).deleteLeft(), some(new Zipper([], 'd', ['e'])))
+    assert.deepEqual(new Zipper([], 1, []).deleteLeft(), none)
+  })
+
+  it('deleteRight', () => {
+    assert.deepEqual(new Zipper(['a', 'b'], 'c', ['d', 'e']).deleteRight(), some(new Zipper(['a', 'b'], 'd', ['e'])))
+    assert.deepEqual(
+      new Zipper(['a', 'b'], 'c', ['d', 'e', 'f']).deleteRight(),
+      some(new Zipper(['a', 'b'], 'd', ['e', 'f']))
+    )
+    assert.deepEqual(new Zipper(['a', 'b'], 'c', []).deleteRight(), some(new Zipper(['a'], 'b', [])))
+    assert.deepEqual(new Zipper([], 1, []).deleteRight(), none)
+  })
+
+  it('map', () => {
+    const fa = new Zipper(['a', 'bb'], 'ccc', ['dddd'])
+    assert.deepEqual(zipper.map(fa, len), new Zipper([1, 2], 3, [4]))
+  })
+
+  it('of', () => {
+    assert.deepEqual(zipper.of(1), new Zipper([], 1, []))
+  })
+
+  it('ap', () => {
+    const fa = new Zipper(['a'], 'b', ['c'])
+    const fab = new Zipper([prepend('P1'), append('A1')], prepend('P2'), [append('A2')])
+    assert.deepEqual(zipper.ap(fab, fa), new Zipper(['P1a', 'aA1'], 'P2b', ['cA2']))
+  })
+
+  it('fromArray', () => {
+    assert.deepEqual(fromArray([]), none)
+    assert.deepEqual(fromArray([1]), some(new Zipper([], 1, [])))
+    assert.deepEqual(fromArray([1], 0), some(new Zipper([], 1, [])))
+    assert.deepEqual(fromArray([1], 1), none)
+    assert.deepEqual(fromArray([1, 2, 3], 1), some(new Zipper([1], 2, [3])))
+  })
+
+  it('fromNonEmptyArray', () => {
+    assert.deepEqual(fromNonEmptyArray(new NonEmptyArray(1, [])), new Zipper([], 1, []))
+    assert.deepEqual(fromNonEmptyArray(new NonEmptyArray(1, [2, 3])), new Zipper([], 1, [2, 3]))
+  })
+
+  it('toString', () => {
+    assert.strictEqual(new Zipper([], 1, []).toString(), 'new Zipper([], 1, [])')
+    assert.strictEqual(new Zipper([], 1, []).inspect(), 'new Zipper([], 1, [])')
+  })
+
+  it('getSemigroup', () => {
+    const S = getSemigroup(semigroupSum)
+    const x = new Zipper([1, 2], 3, [4])
+    const y = new Zipper([5], 6, [7])
+    assert.deepEqual(S.concat(x, y), new Zipper([1, 2, 5], 9, [4, 7]))
+  })
+
+  it('getMonoid', () => {
+    const M = getMonoid(monoidSum)
+    const x = new Zipper([1, 2], 3, [4])
+    assert.deepEqual(M.concat(x, M.empty), x)
+    assert.deepEqual(M.concat(M.empty, x), x)
+  })
+
+  it('reduce', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.deepEqual(zipper.reduce(fa, '', (b: string, a: string) => b + a), 'abcd')
+  })
+
+  it('traverse', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.deepEqual(zipper.traverse(option)(fa, a => some(a)), some(fa))
+  })
+
+  it('extract', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d'])
+    assert.strictEqual(zipper.extract(fa), 'c')
+  })
+
+  it('extend', () => {
+    const fa = new Zipper(['a', 'b'], 'c', ['d', 'e'])
+    const f = (fa: Zipper<string>) => fa.toString()
+    assert.deepEqual(
+      zipper.extend(fa, f),
+      new Zipper(
+        ['new Zipper([], "a", ["b", "c", "d", "e"])', 'new Zipper(["a"], "b", ["c", "d", "e"])'],
+        'new Zipper(["a", "b"], "c", ["d", "e"])',
+        ['new Zipper(["a", "b", "c"], "d", ["e"])', 'new Zipper(["a", "b", "c", "d"], "e", [])']
+      )
+    )
+  })
+})