categories firs implementation and Fn instance

src/clj_control/category.clj

@@ -0,0 +1,28 @@
+(ns clj-control.category)
+
+(defprotocol Category
+  "class Category cat where
+     id ::cat a a
+     (.) :: cat b c -> cat a b -> cat a c"
+  (c-id [this])
+  (c-comp [this c]))
+
+
+(defn >>>
+  "(>>>) :: Category cat => cat a b -> cat b c -> cat a c
+   Left-to-right composition "
+  ([cab cbc]
+     (c-comp cab cbc))
+  ([cab cbc & args]
+     (if (empty? args)
+       (c-comp cab cbc)
+       (apply >>> (cons (c-comp cab cbc) args)))))
+
+
+(defn <<<
+  "(<<<) :: Category cat => cat b c -> cat a b -> cat a c
+     Right-to-left composition"
+  ([cbc cab]
+     (c-comp cab cbc))
+  ([cbc cab & args]
+     (apply >>> (reverse (flatten (list [cbc cab] args))))))

src/clj_control/core.clj

@@ -2,7 +2,8 @@
   (:use [clj-control.functor]
         [clj-control.applicative]
         [clj-control.monad]
-        [clj-control.monoid]))
+        [clj-control.monoid]
+        [clj-control.category]))
 
 ;; Functions
 
@@ -40,6 +41,10 @@
   (m->> [this m]
         (default-m->> this m)))
 
+(extend-type clojure.lang.Fn
+  Category
+  (c-id [this] this)
+  (c-comp [this c] (comp c this)))
 
 ;; Vectors
 

test/clj_control/test/applicative.clj

@@ -75,6 +75,9 @@
        (repeat '())
        (let [xs (first matrix)
              xss (rest matrix)]
+;;         (-> (repeat (count xs) (curry 2 cons))
+;;             (af-* xs)
+;;             (af-* (take (count xs) (transpose xss))))))))
          (af-*
           (af-* (repeat (count xs) (curry 2 cons)) xs)
           (take (count xs) (transpose xss)))))))

test/clj_control/test/category.clj

@@ -0,0 +1,14 @@
+(ns clj-control.test.category
+  (:use [clj-control.category] :reload)
+  (:use [clj-control.core] :reload)
+  (:use [clj-control.utils] :reload)
+  (:use [clojure.test]))
+
+
+(deftest functions-should-work-with-the->>>-combinator
+  (is (= ((>>> inc inc (partial * 2) inc inc inc (partial * 3)) 3)
+         39)))
+
+(deftest functions-should-work-with-the-<<<-combinator
+  (is (= ((<<< inc inc (partial * 2) inc inc inc (partial * 3)) 3)
+         26)))