crocks/Star/index.js

A collection of well known Algebraic Datatypes for your utter enjoyment.

/** @license ISC License (c) copyright 2016 original and current authors */
/** @author Ian Hofmann-Hicks (evil) */

var VERSION = 2

var _implements = require('../core/implements')
var _inspect = require('../core/inspect')
var _type = require('../core/types').type('Star')
var __type = require('../core/types').typeFn(_type(), VERSION)
var fl = require('../core/flNames')

var array = require('../core/array')
var isFunction = require('../core/isFunction')
var isMonad = require('../core/isMonad')
var isSameType = require('../core/isSameType')

var Pair = require('../core/Pair')

var merge =
  function (fn, m) { return m.merge(fn); }

var sequence =
  function (af, m) { return array.sequence(af, m); }

function _Star(Monad) {
  if(!isMonad(Monad)) {
    throw new TypeError('Star: Monad required for construction')
  }

  var _id =
    function () { return Star(Monad.of); }

  var innerType =
    Monad.type()

  var innerFullType =
    Monad['@@type']

  var outerType =
    (_type()) + "( " + innerType + " )"

  var typeString =
    __type + "( " + innerFullType + " )"

  var type =
    function () { return outerType; }

  function Star(runWith) {
    var obj;

    if(!isFunction(runWith)) {
      throw new TypeError((outerType + ": Function in the form (a -> m b) required"))
    }

    var inspect =
      function () { return ("" + outerType + (_inspect(runWith))); }

    var id =
      _id

    function compose(method) {
      return function(s) {
        if(!isSameType(Star, s)) {
          throw new TypeError((outerType + "." + method + ": " + outerType + " required"))
        }

        return Star(function(x) {
          var m = runWith(x)

          if(!isSameType(Monad, m)) {
            throw new TypeError((outerType + "." + method + ": Computations must return a type of " + innerType))
          }

          return m.chain(function(val) {
            var inner = s.runWith(val)

            if(!isSameType(m, inner)) {
              throw new TypeError((outerType + "." + method + ": Both computations must return a type of " + innerType))
            }

            return inner
          })
        })
      }
    }

    function map(method) {
      return function(fn) {
        if(!isFunction(fn)) {
          throw new TypeError((outerType + "." + method + ": Function required"))
        }

        return Star(function(x) {
          var m = runWith(x)

          if(!isSameType(Monad, m)) {
            throw new TypeError((outerType + "." + method + ": Computations must return a type of " + innerType))
          }

          return m.map(fn)
        })
      }
    }

    function contramap(method) {
      return function(fn) {
        if(!isFunction(fn)) {
          throw new TypeError((outerType + "." + method + ": Function required"))
        }

        return Star(function (x) { return runWith(fn(x)); })
      }
    }

    function promap(method) {
      return function(l, r) {
        if(!isFunction(l) || !isFunction(r)) {
          throw new TypeError((outerType + "." + method + ": Functions required for both arguments"))
        }

        return Star(function(x) {
          var m = runWith(l(x))

          if(!isSameType(Monad, m)) {
            throw new TypeError((outerType + "." + method + ": Computation must return a type of " + innerType))
          }

          return m.map(r)
        })
      }
    }

    function first() {
      return Star(function(x) {
        if(!isSameType(Pair, x)) {
          throw TypeError((outerType + ".first: Pair required for computation input"))
        }

        var m = runWith(x.fst())

        if(!isSameType(Monad, m)) {
          throw new TypeError((outerType + ".first: Computation must return a type of " + innerType))
        }

        return m.map(function (l) { return Pair(l, x.snd()); })
      })
    }

    function second() {
      return Star(function(x) {
        if(!isSameType(Pair, x)) {
          throw TypeError((outerType + ".second: Pair required for computation input"))
        }

        var m = runWith(x.snd())

        if(!isSameType(Monad, m)) {
          throw new TypeError((outerType + ".second: Computation must return a type of " + innerType))
        }

        return m.map(function (r) { return Pair(x.fst(), r); })
      })
    }

    function both() {
      return Star(function(x) {
        if(!isSameType(Pair, x)) {
          throw TypeError((outerType + ".both: Pair required for computation input"))
        }

        var p = x.bimap(runWith, runWith)
        var m = p.fst()

        if(!isSameType(Monad, m)) {
          throw new TypeError((outerType + ".both: Computation must return a type of " + innerType))
        }

        return sequence(m.of, merge(function (x, y) { return [ x, y ]; }, p)).map(function (x) { return Pair(x[0], x[1]); })
      })
    }

    return ( obj = {
      inspect: inspect, toString: inspect, type: type,
      runWith: runWith, id: id, first: first, second: second, both: both,
      compose: compose('compose'),
      contramap: contramap('contramap'),
      map: map('map'),
      promap: promap('promap')
    }, obj[fl.id] = id, obj[fl.compose] = compose(fl.compose), obj[fl.contramap] = contramap(fl.contramap), obj[fl.map] = map(fl.map), obj[fl.promap] = promap(fl.promap), obj['@@type'] = typeString, obj.constructor = Star, obj )
  }

  Star.id = _id
  Star.type = type

  Star[fl.id] = _id
  Star['@@type'] = typeString

  Star['@@implements'] = _implements(
    [ 'compose', 'contramap', 'id', 'map', 'promap' ]
  )

  return Star
}

module.exports = _Star