fr 0.9.1

data/lib/fr/functor/either.rb

@@ -0,0 +1,17 @@
+#
+# Because Either is a monad, we automatically derive
+# the implementation for `map` from `liftM`.
+#
+# module Fr
+#   class << Either
+#     include Functor
+#
+#     def map(f = nil, x = nil, &block)
+#       (x.nil?) ?
+#         (block_given?) ?
+#           f.map(&block) :         # f.map(fa){ .. }
+#           lambda{|x| x.map(&f) } :# f.map(lambda{ .. }).call(fa)
+#           x.map(&f)               # f.map(lambda{ .. }, fa)
+#     end
+#   end
+# end

data/lib/fr/functor/maybe.rb

@@ -0,0 +1,17 @@
+#
+# Because Either is a monad, we automatically derive
+# the implementation for `map` from `liftM`.
+#
+# module Fr
+#   class << Maybe
+#     include Functor
+#
+#     def map(f = nil, x = nil, &block)
+#       (x.nil?) ?
+#         (block_given?) ?
+#           f.map(&block) :         # f.map(fa){ .. }
+#           lambda{|x| x.map(&f) } :# f.map(lambda{ .. }).call(fa)
+#           x.map(&f)               # f.map(lambda{ .. }, fa)
+#     end
+#   end
+# end

data/lib/fr/maybe.rb

@@ -0,0 +1,76 @@
+module Fr
+
+  class Maybe
+    class Some < Maybe
+      def initialize(value)
+        @value = value
+      end
+
+      def map
+        Some.new(yield @value)
+      end
+
+      def fold(default)
+        yield @value
+      end
+
+      def some?
+        true
+      end
+
+      def none?
+        false
+      end
+
+      def ==(other)
+        Maybe === other and other.fold(false){|x| x == @value }
+      end
+
+      alias_method :eql?, :==
+
+      def hash
+        @value.hash
+      end
+
+      def inspect
+        "Fr.some(#{@value.inspect})"
+      end
+    end
+
+    class None_ < Maybe
+      def map
+        self
+      end
+
+      def fold(default)
+        default
+      end
+
+      def some?
+        false
+      end
+
+      def none?
+        true
+      end
+
+      def ==(other)
+        None_ === other
+      end
+
+      alias_method :eql?, :==
+
+      def inspect
+        "Fr.none"
+      end
+    end
+
+    # Singleton instance
+    None = None_.new
+  end
+
+end
+
+require "fr/functor/maybe"
+require "fr/monoid/maybe"
+require "fr/monad/maybe"

data/lib/fr/monad.rb

@@ -0,0 +1,236 @@
+module Fr
+  module Monad
+    # include Applicative
+    include Functor
+
+    # Perform each action, from left to right
+    # :: Monad m => [m a] -> m [a]
+    #
+    # @todo: Need trampoline for 2500+ ms
+    def sequence(ms)
+      ms.inject(unit []) do |prev, curr|
+        bind(prev) do |xs|
+          bind(curr) do |x|
+            unit(xs + [x])
+          end
+        end
+      end
+    end
+
+    # Remove one level of monadic structure
+    # :: Monad m => m (m a) -> m a
+    #
+    # >> m.join(m.unit(m.unit(100)))
+    # => m.unit(100)
+    #
+    # >> Array.join([[1],[2],[3]])
+    # => [1,2,3]
+    #
+    def join(mm)
+      bind(mm){|x| x }
+    end
+
+    # :: Monad m => (a -> m b) -> [a] -> m [b]
+    #
+    # >> m.filter(lambda{|a| m.unit(a.even?) }).call([0,1,2,3])
+    # => m.unit([true,false,true,false])
+    #
+    def mapM(f, as = nil)
+      if as.nil?
+        lambda do |as|
+          sequence(as.map(&f))
+        end
+      else
+        sequence(as.map(&f))
+      end
+    end
+
+    # :: Monad m => [a] -> (a -> m b) -> m [b]
+    #
+    # >> m.forM([0,1,2,3]){|a| m.unit(a.even?) }
+    # => m.unit([true,false,true,false])
+    #
+    # >> m.forM([0,1,2,3], lambda{|a| m.unit(a.even?) })
+    # => m.unit([true,false,true,false])
+    #
+    # >> m.forM([0,1,2,3]).call(lambda{|a| m.unit(a.even?) })
+    # => m.unit([true,false,true,false])
+    #
+    def forM(as, f = nil, &block)
+      rest =
+        lambda do |f|
+          sequence(as.map(&block))
+        end
+
+      (f.nil?) ?
+        (block_given?) ?
+          rest.call(block) : rest : rest.call(f)
+    end
+
+    # Left-to-right Kleisli composition of monads
+    # :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
+    #
+    # >> m.composeM(lambda{|a| m.unit(a.to_s)   },
+    #               lambda{|b| m.unit(b.length) }).call(450)
+    # => m.unit(3)
+    #
+    def composeM(f, g = nil, &block)
+      rest =
+        lambda do |g|
+          lambda do |a|
+            bind(f.call(a)) do |b|
+              g.call(b)
+            end
+          end
+        end
+
+      (g.nil?) ?
+        (block_given?) ?
+          rest.call(block) : rest : rest.call(g)
+    end
+
+    # :: Monad m => (a -> m Boolean) -> [a] -> m [a]
+    #
+    # >> m.filterM(lambda{|a| m.unit(a.even?) }).call([0,1,2,3,4])
+    # => m.unit([0,2,4])
+    #
+    # Not implemented:
+    # >> [0,1,2,3,4].filterM{|a| m.unit(a.even?) }
+    # => m.unit([0,2,4])
+    #
+    def filterM(f, as = nil)
+      rec =
+        lambda do |as|
+          if as.empty?
+            unit([])
+          else
+            a, *as = as
+            bind(f.call(a)) do |bool|
+              bind(rec.call(as)) do |rest|
+                unit(bool ?
+                  a.cons(rest) : rest)
+              end
+            end
+          end
+        end
+
+      (as.nil?) ?
+        rec : rec.call(as)
+    end
+
+    # :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]
+    #
+    # >> m.zipM(lambda{|a,b| m.unit(a + b) }).call([1,2,3]).call([3,2,1])
+    # => m.unit([6,6,6])
+    #
+    # Not implemented:
+    # >> [1,2,3].zipM([3,2,1]){|a,b| m.unit(a + b) }
+    # => m.unit([6,6,6])
+    #
+    def zipM(f, xs = nil, ys = nil)
+      rest =
+        lambda do |xs|
+          lambda do |ys|
+            sequence(xs.zip(ys).map{|(x,y)| f.call(x, y) })
+          end
+        end
+
+      (ys.nil?) ?
+        (xs.nil?) ?
+          rest : rest.call(xs) : rest.call(xs).call(ys)
+    end
+
+    # :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
+    #
+    # >> m.foldM(lambda{|a,b| m.unit(a | b) }).call(0).call([1,2,4])
+    # => m.unit(7)
+    #
+    # Not implemented:
+    # >> [1,2,4].foldM(0){|a,b| m.unit(a | b) }
+    # => m.unit(7)
+    #
+    def foldM(f, seed = nil, bs = nil)
+      rest =
+        lambda do |seed|
+          lambda do |bs|
+            if bs.empty?
+              unit(seed)
+            else
+              b, *bs = bs
+              bind(f.call(seed, b)) do |seed_|
+                rec.call(seed_).call(bs)
+              end
+            end
+          end
+        end
+
+      (bs.nil?) ?
+        (seed.nil?) ?
+          rest : rest.call(seed) : rest.call(seed).call(bs)
+    end
+
+    # :: Monad m => Bool -> m () -> m ()
+    def whenM(condition)
+      # todo
+    end
+
+    # :: Monad m => Bool -> m () -> m ()
+    def unlessM(condition)
+      # todo
+    end
+
+    # :: Monad m => (a -> b) -> m a -> m b
+    #
+    # >> m.liftM(lambda{|x| x.even? }).call(m.unit(30))
+    # => m.unit(true)
+    #
+    def liftM(f = nil, ma = nil, &block)
+      rest =
+        lambda do |f|
+          lambda do |ma|
+            bind(ma) do |a|
+              unit(f.call(a))
+            end
+          end
+        end
+
+      (ma.nil?) ?
+        (block_given?) ?
+          rest.call(block).call(f) :# m.liftM(ma){ .. }
+          rest.call(f)             :# m.liftM(lambda{ .. }).call(ma)
+          rest.call(f).call(ma)     # m.liftM(lambda{ .. }, ma)
+    end
+
+    # Automatically derive an implementation of `Functor.map` from `liftM`.
+    #
+    # Notice
+    #   liftM :: Monad   m => (a -> b) -> m a -> m b
+    #   map   :: Functor f => (a -> b) -> f a -> f b
+    alias_method :map, :liftM
+
+    # :: Monad m => m (a -> b) -> m a -> m b
+    #
+    # >> mf = m.unit(lambda{|x| lambda{|y| x + y }})
+    #
+    # >> ab = m.applyM(mf)
+    # >> ma = m.applyM(ab.call(m.unit 3))
+    # >> mb =          ma.call(m.unit 4)
+    #
+    # => m.unit(7)
+    #
+    def applyM(mf, ma = nil)
+      rest =
+        lambda do |ma|
+          bind(mf) do |f|
+            bind(ma) do |a|
+              unit(f.call(a))
+            end
+          end
+        end
+
+      (ma.nil?) ?
+        rest : rest.call(ma)
+    end
+
+  end
+end

data/lib/fr/monad/array.rb

@@ -0,0 +1,21 @@
+class << Array
+  include Fr::Monad
+
+  # Evaluators
+  #############################################
+
+  def run(computation)
+    computation
+  end
+
+  # Combinators
+  #############################################
+
+  def unit(value)
+    [value]
+  end
+
+  def bind(x, &f)
+    x.map(&f).inject([], &:concat)
+  end
+end

data/lib/fr/monad/either.rb

@@ -0,0 +1,18 @@
+module Fr
+
+  class << Either
+    include Monad
+
+    # Combinators
+    #############################################
+
+    def unit(value)
+      Either::Right.new(value)
+    end
+
+    def bind(x, &f)
+      x.fold(lambda{|l| x }, lambda{|r| f.call(r) })
+    end
+  end
+
+end

data/lib/fr/monad/maybe.rb

@@ -0,0 +1,24 @@
+module Fr
+
+  class << Maybe
+    include Monad
+
+    # Evaluators
+    #############################################
+    def run(computation)
+      computation
+    end
+
+    # Combinators
+    #############################################
+
+    def unit(value)
+      Maybe::Some.new(value)
+    end
+
+    def bind(x, &f)
+      x.fold(x, &f)
+    end
+  end
+
+end

data/lib/fr/monad/random.rb

@@ -0,0 +1,50 @@
+module Fr
+
+  class << Random
+    include Monad
+
+    # Evaluators
+    #############################################
+
+    def run(computation, scale = 1.0)
+      computation.call(scale)
+    end
+
+    def eval(computation, scale = 1.0)
+      computation.call(scale)[0]
+    end
+
+    # Combinators
+    #############################################
+
+    def unit(value)
+      lambda do |scale|
+        [value, scale]
+      end
+    end
+
+    def bind(f, &g)
+      lambda do |scale|
+        value, scale = f.call(scale)
+        g.call(value).call(scale)
+      end
+    end
+
+    # Actions
+    #############################################
+
+    def rand(limit = nil)
+      lambda do |scale|
+        [Kernel.rand(limit), scale]
+      end
+    end
+
+    def scale(number, zero)
+      # Linearly scale given number towards zero
+      lambda do |scale|
+        [zero + scale * (number - zero), scale]
+      end
+    end
+  end
+
+end