gistfile1.clj

(ns clj-arrows.core)

;; Take a look at -> http://www.haskell.org/haskellwiki/Arrow_tutorial

(defn def-arrow [& opts]
  (let [opts-map (apply hash-map opts)]
    {:arr (:arr opts-map)
     :first (:first opts-map)
     :second (:second opts-map)}))

(defn arr->>> [a b]
  (def-arrow :arr #((:arr b) ((:arr a) %1))))

(defn arr-split []
  (def-arrow :arr (fn [x] [x x])))

(defn arr-unsplit [op]
  (def-arrow :arr (fn [[b c]] (op b c))))

(defn arr-*** [a b]
  (arr->>> (:first a) (:second b)))

(defn arr-&&& [a b]
  (def-arrow :arr #((:arr (arr->>> (arr->>> (arr-split) (:first a)) (:second b))) %1)))

(defn arr-liftA2 [f a b]
  (def-arrow :arr #((:arr (arr->>> (arr->>> (arr->>> (arr-split) (:first a)) (:second b)) (arr-unsplit f))) %1)))


;; a Simple arrow from the Haskell tutorial

(defn simple-arrow [f]
  (def-arrow
    :arr f
    :first (def-arrow :arr (fn [[b c]] [(f b) c]))
    :second (def-arrow :arr (fn [[b c]] [b (f c)]))))

;; example
((:arr (arr-liftA2 #(+ %1 %2)
                   (simple-arrow #(/ %1 2))
                   (simple-arrow #(+ (* %1 3)1)))) 8)

;   8 -> (8, 8)             split
;   (8, 8) -> (4, 8)        first f (x `div` 2 of the first element)
;   (4, 8) -> (4, 25)       second g (3*x + 1 of the second element)
;   (4, 25) -> 29           applies (+) to tuple elements.
;
;             +------> f ---------+
;             |                   v
;   8 ---> (split)          (unsplit (+)) ----> 29
;             |                   ^
;             +------> g ---------+

; Hic Haskell ist

; newtype SimpleFunc a b = SimpleFunc {
;     runF :: (a -> b)
; }
;
; instance Arrow SimpleFunc where
;     arr f = SimpleFunc f
;     first (SimpleFunc f) = SimpleFunc (mapFst f)
;                   where mapFst g (a,b) = (g a, b)
;     second (SimpleFunc f) = SimpleFunc (mapSnd f)
;                   where mapSnd g (a,b) = (a, g b)
;
; instance Category SimpleFunc where
;     (SimpleFunc g) . (SimpleFunc f) = SimpleFunc (g . f)
;     id = arr id

; f, g :: SimpleFunc Int Int
; f = arr (`div` 2)
; g = arr (\x -> x*3 + 1)

; h :: SimpleFunc Int Int
; h = liftA2 (+) f g
;
; hOutput :: Int
; hOutput = runF h 8