fr 0.9.1

data/lib/fr/monad/reader.rb

@@ -0,0 +1,45 @@
+module Fr
+  module Reader
+  end
+
+  class << Reader
+    include Monad
+
+    # Evaluators
+    #############################################
+
+    def run(computation, state)
+      computation.call(state)
+    end
+
+    def eval(computation, state)
+      computation.call(state)[:value]
+    end
+
+    # Combinators
+    #############################################
+
+    def unit(value)
+      lambda do |state|
+        Hash[state: state, value: value]
+      end
+    end
+
+    def bind(f, &g)
+      lambda do |state|
+        tuple = f.call(state)
+        g.call(tuple[:value])
+         .call(tuple[:state])
+      end
+    end
+
+    # Actions
+    #############################################
+
+    def ask
+      lambda do |state|
+        Hash[state: state, value: state]
+      end
+    end
+  end
+end

data/lib/fr/monad/state.rb

@@ -0,0 +1,62 @@
+module Fr
+
+  module State
+  end
+
+  class << State
+    include Monad
+
+    # Evaluators
+    #############################################
+
+    def run(computation, state)
+      computation.call(state)
+    end
+
+    def eval(computation, state)
+      computation.call(state)[:value]
+    end
+
+    def exec(computation, state)
+      computation.call(state)[:state]
+    end
+
+    # Combinators
+    #############################################
+
+    def unit(value)
+      lambda do |state|
+        Hash[state: state, value: value]
+      end
+    end
+
+    def bind(f, &g)
+      lambda do |state|
+        tuple = f.call(state)
+        g.call(tuple[:value]).call(tuple[:state])
+      end
+    end
+
+    # Actions
+    #############################################
+
+    def put(n)
+      lambda do |state|
+        Hash[state: n, value: nil]
+      end
+    end
+
+    def get
+      lambda do |state|
+        Hash[state: state, value: state]
+      end
+    end
+
+    def update
+      lambda do |state|
+        Hash[state: yield(state), value: nil]
+      end
+    end
+  end
+
+end

data/lib/fr/monad/writer.rb

@@ -0,0 +1,49 @@
+module Fr
+  module Writer
+  end
+
+  class << Writer
+    include Monad
+
+    # Evaluators
+    #############################################
+
+    def run(computation, monoid)
+      computation.call(monoid.zero, monoid)
+    end
+
+    def eval(computation, monoid)
+      computation.call(monoid.zero, monoid)[:value]
+    end
+
+    def exec(computation, monoid)
+      computation.call(monoid.zero, monoid)[:state]
+    end
+
+    # Combinators
+    #############################################
+
+    def unit(value)
+      lambda do |state, monoid|
+        Hash[state: state, monoid: monoid, value: value]
+      end
+    end
+
+    def bind(f, &g)
+      lambda do |state, monoid|
+        tuple = f.call(state, monoid)
+        g.call(tuple[:value])
+         .call(tuple[:state], tuple[:monoid])
+      end
+    end
+
+    # Actions
+    #############################################
+
+    def tell(write)
+      lambda do |state, monoid|
+        Hash[state: monoid.plus(state, write), monoid: monoid, value: nil]
+      end
+    end
+  end
+end

data/lib/fr/monoid.rb

@@ -0,0 +1,52 @@
+module Fr
+  module Monoid
+    # zero: m
+    # plus: m -> m -> m
+
+    # :: Monoid m => [m] -> m
+    #
+    # >> [m.unit(1), m.unit(2)].sum
+    # => m.plus(m.plus(m.zero, m.unit(1)), m.unit(2))
+    #
+    def sum(ms)
+      ms.inject(zero){|sum,m| plus(sum, m) }
+    end
+
+    # :: Monad m, Monoid m => Bool -> m ()
+    #
+    # >> m.guard(false)
+    # => m.zero
+    #
+    # Not supported:
+    # >> true.guard(m.unit(x))
+    # => m.unit(x)
+    #
+    def guard(bool)
+      bool ?
+        unit(nil) : zero
+    end
+
+    # :: Monad m, Monoid m => (a -> Bool) -> m a -> m a
+    #
+    # >> m.filter(lambda{|x| x.odd? }).call(m.unit(10))
+    # => m.zero
+    #
+    # Not supported:
+    # >> m.unit(10).filter{|x| x.odd? }
+    # => m.zero
+    #
+    def filter(f, ma = nil)
+      rest =
+        lambda do |ma|
+          bind(ma) do |a|
+            f.call(a) ?
+              unit(a) : zero
+          end
+        end
+
+      (ma.nil?) ?
+        rest : rest.call(ma)
+    end
+
+  end
+end

data/lib/fr/monoid/array.rb

@@ -0,0 +1,13 @@
+class << Array
+  include Fr::Monoid
+
+  # :: Array a
+  def zero
+    []
+  end
+
+  # :: Array a -> Array a -> Array a
+  def plus(a, b)
+    a + b
+  end
+end

data/lib/fr/monoid/boolean.rb

@@ -0,0 +1,23 @@
+class Conjunctive
+  class << self
+    def zero
+      true
+    end
+
+    def sum(a, b)
+      a && b
+    end
+  end
+end
+
+class Disjunctive
+  class << self
+    def zero
+      false
+    end
+
+    def sum(a, b)
+      a || b
+    end
+  end
+end

data/lib/fr/monoid/either.rb

@@ -0,0 +1,13 @@
+module Fr
+  class << Either
+    include Monoid
+
+    def zero
+      Either::Left.new(nil)
+    end
+
+    def plus(a, b)
+      (a.left?) ? b : a
+    end
+  end
+end

data/lib/fr/monoid/maybe.rb

@@ -0,0 +1,15 @@
+module Fr
+  class << Maybe
+    include Monoid
+
+    # :: Maybe a
+    def zero
+      Maybe::None
+    end
+
+    # :: Maybe a -> Maybe a -> Maybe a
+    def plus(a, b)
+      (a.none?) ? b : a
+    end
+  end
+end

data/lib/fr/monoid/numeric.rb

@@ -0,0 +1,31 @@
+class Additive
+  class << self
+    include Fr::Monoid
+
+    # :: Numeric a => a
+    def zero
+      0
+    end
+
+    # :: Numeric a => a -> a -> a
+    def plus(a, b)
+      a + b
+    end
+  end
+end
+
+class Multiplicative
+  class << self
+    include Fr::Monoid
+
+    # :: Numeric a => a
+    def zero
+      1
+    end
+
+    # :: Numeric a => a -> a -> a
+    def plus(a, b)
+      a * b
+    end
+  end
+end

data/lib/fr/monoid/string.rb

@@ -0,0 +1,11 @@
+class << String
+  include Fr::Monoid
+
+  def zero
+    ""
+  end
+
+  def plus(a, b)
+    a + b
+  end
+end

data/lib/fr/numeric.rb

@@ -0,0 +1 @@
+require "fr/monoid/numeric"

data/lib/fr/object.rb

@@ -0,0 +1,45 @@
+class Object
+
+  # @group List Constructors
+  #############################################################################
+
+  # Prepend the item to the front of a new list
+  #
+  # @example
+  #   1.cons              #=> [1]
+  #   1.cons(2.cons)      #=> [1, 2]
+  #   1.cons([0, 0, 0])   #=> [1, 0, 0, 0]
+  #
+  # @return [Array]
+  def cons(tail = [])
+    [self] + tail
+  end
+
+  # Append the item to rear of a new list
+  #
+  # @example
+  #   1.snoc              #=> [1]
+  #   1.snoc(2.snoc)      #=> [2, 1]
+  #   1.snoc([0, 0, 0])   #=> [0, 0, 0, 1]
+  #
+  # @return [Array]
+  def snoc(init = [])
+    init + [self]
+  end
+
+  # @group Combinators
+  #############################################################################
+
+  # Yields `self` to a block argument
+  #
+  # @example
+  #   nil.bind{|a| a.nil? }   #=> true
+  #   100.bind{|a| a.nil? }   #=> false
+  #
+  def bind
+    yield self
+  end
+
+  # @endgroup
+  #############################################################################
+end

data/lib/fr/string.rb

@@ -0,0 +1 @@
+require "fr/monoid/string.rb"

data/lib/fr/szipper.rb

@@ -0,0 +1,36 @@
+module Fr
+  module SZipper
+    autoload :AbstractCursor, "fr/szipper/abstract_cursor"
+    autoload :EditedCursor,   "fr/szipper/edited_cursor"
+    autoload :MemoizedCursor, "fr/szipper/memoized_cursor"
+    autoload :HeadPrevCursor, "fr/szipper/head_prev_cursor"
+    autoload :TailNextCursor, "fr/szipper/tail_next_cursor"
+    autoload :HeadCursor,     "fr/szipper/head_cursor"
+    autoload :Enumerable,     "fr/szipper/enumerable"
+    autoload :Node,           "fr/szipper/node"
+  end
+
+  class << SZipper
+
+    # Constructors a zipper for traversing the given tree or
+    # subtree. The `node` value can be any structure where
+    #
+    #   node#next
+    #     the next node
+    #
+    #   node#last?
+    #     true if no nodes are allowed to be inserted
+    #
+    #   node#copy(next: ...)
+    #     creates a new node with the given next node
+    #
+    def build(node = nil)
+      if node
+        Fr::SZipper::HeadCursor.new(node)
+      else
+        Fr::SZipper::HeadPrevCursor.new(nil)
+      end
+    end
+  end
+
+end

data/lib/fr/szipper/abstract_cursor.rb

@@ -0,0 +1,63 @@
+module Fr
+  module SZipper
+
+    class AbstractCursor
+      # : node
+      # : prev(phantom = false)
+      # : next(phantom = false)
+      # : head?
+      # : tail?
+      # : empty?
+      # : head
+      # : tail
+      # : position
+      # : append(node)
+      # : prepend(node)
+      # : update(node = nil) {|node| node }
+      # : replace(node)
+      # : delete
+      # : truncate
+      include Enumerable
+
+      def empty?
+        false
+      end
+
+      def next(phantom = false)
+        @__next ||= begin
+          if tail?
+            if phantom
+              TailNextCursor.new(self)
+            else
+              raise Errors::ZipperError,
+                "tail node has no next"
+            end
+          else
+            MemoizedCursor.new(node.next, self)
+          end
+        end
+      end
+
+      def head
+        cursor = self
+        cursor = cursor.prev until cursor.head?
+        cursor
+      end
+
+      def tail
+        cursor = self
+        cursor = cursor.next until cursor.tail?
+        cursor
+      end
+
+      def position
+        @prev.position + 1
+      end
+
+      def truncate
+        update(node.copy(next: nil))
+      end
+    end
+
+  end
+end