PersistentList support

scripts/build.clj

@@ -8,7 +8,7 @@
    {:main 'cats.runner
     :output-to "out/tests.js"
     :output-dir "out"
-    :optimizations :advanced
+    :optimizations :none
     :target :nodejs
     :verbose true})
   (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds"))

src/cats/builtin.cljc

@@ -44,10 +44,119 @@
   (-extract [_] nil))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (Lazy) Sequence Monad
+;; Sequence Monad i.e. PersistentList
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def sequence-context
+  (reify
+    p/Context
+    (-get-level [_] ctx/+level-default+)
+
+    p/Semigroup
+    (-mappend [_ sv sv']
+      (into sv' (reverse sv)))
+
+    p/Monoid
+    (-mempty [_] ())
+
+    p/Functor
+    (-fmap [_ f v]
+      (loop [[h & t :as c] v
+             result ()]
+        (if (empty? c)
+          (reverse result)
+          (recur t (cons (f h) result)))))
+
+    p/Applicative
+    (-pure [_ v] (list v))
+
+    (-fapply [_ self av]
+      ;; Each function (outer loop) applied to each value (inner loop).
+      (->> (loop [[h & t :as c] self
+                  result ()]
+             (if (empty? c)
+               result
+               (recur t
+                      (cons (loop [[h' & t' :as c'] av
+                                   result' ()]
+                              (if (empty? c')
+                                result'
+                                (recur t' (cons (h h') result'))))
+                            result))))
+           ;; Note that both `result` & `result'` above are
+           ;; in reverse order.
+           ;; Conjing elements of %2 into %1 below is done in
+           ;; in reverse order, so final result is correctly
+           ;; ordered.
+           (reduce #(into %1 %2) ())))
+
+
+    p/Monad
+    (-mreturn [_ v]
+      (list v))
+
+    (-mbind [_ self f]
+      (->> (loop [[h & t :as c] self
+                  result ()]
+             (if (empty? c)
+               result
+               (recur t (cons (f h) result))))
+           ;; Note that `result` above is in reverse order.
+           ;; Conjing elements of %2 into %1 below is done in
+           ;; in reverse order, so final result is correctly
+           ;; ordered.
+           (reduce #(into %1 %2) ())))
+
+    p/MonadZero
+    (-mzero [_] ())
+
+    p/MonadPlus
+    (-mplus [_ mv mv']
+      (into mv' (reverse mv)))
+
+    p/Foldable
+    (-foldr [ctx f z xs]
+      (let [x (first xs)]
+        (if (nil? x)
+          z
+          (let [xs (rest xs)]
+            (f x (p/-foldr ctx f z xs))))))
+
+    (-foldl [ctx f z xs]
+      (reduce f z xs))
+
+    p/Traversable
+    (-traverse [ctx f tv]
+      (let [as (p/-fmap ctx f tv)]
+        (p/-foldr ctx
+                  (fn [a acc]
+                    (m/alet [x a
+                             xs acc]
+                      (cons x xs)))
+                  (m/pure ())
+                  as)))
+
+    p/Printable
+    (-repr [_]
+      "#<List>")))
+
+(util/make-printable (type sequence-context))
+
+(extend-type #?(:clj  clojure.lang.PersistentList
+                :cljs cljs.core.List)
+  p/Contextual
+  (-get-context [_] sequence-context))
+
+(extend-type #?(:clj  clojure.lang.PersistentList$EmptyList
+                :cljs cljs.core.EmptyList)
+  p/Contextual
+  (-get-context [_] sequence-context))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Lazy Sequence Monad
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def lazy-sequence-context
   (reify
     p/Context
     (-get-level [_] ctx/+level-default+)
@@ -112,14 +221,14 @@
 
     p/Printable
     (-repr [_]
-      "#<Sequence>")))
+      "#<LazySequence>")))
 
-(util/make-printable (type sequence-context))
+(util/make-printable (type lazy-sequence-context))
 
 (extend-type #?(:clj  clojure.lang.LazySeq
                 :cljs cljs.core.LazySeq)
   p/Contextual
-  (-get-context [_] sequence-context))
+  (-get-context [_] lazy-sequence-context))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Range

test/cats/builtin_spec.cljc

@@ -169,7 +169,7 @@
 ;; Sequence
 
 (defn sequence-gen [g]
-  (gen/fmap #(lazy-seq %) (gen/vector g)))
+  (gen/list g))
 
 (defspec sequence-semigroup 10
   (lt/semigroup-associativity
@@ -188,8 +188,8 @@
 (defspec sequence-second-functor-law 10
   (lt/second-functor-law
    {:gen (sequence-gen gen/any)
-    :f   #(lazy-seq [%])
-    :g   #(lazy-seq [%])}))
+    :f   #(list %)
+    :g   #(list %)}))
 
 (defspec sequence-applicative-identity 10
   (lt/applicative-identity-law
@@ -206,14 +206,14 @@
   (lt/applicative-interchange
    {:ctx  b/sequence-context
     :gen  gen/int
-    :appf (lazy-seq [inc])}))
+    :appf (list inc)}))
 
 (defspec sequence-applicative-composition 10
   (lt/applicative-composition
    {:ctx  b/sequence-context
     :gen  gen/int
-    :appf (lazy-seq [inc])
-    :appg (lazy-seq [dec])}))
+    :appf (list inc)
+    :appg (list dec)}))
 
 (defspec sequence-first-monad-law 10
   (lt/first-monad-law
@@ -229,6 +229,92 @@
     :f   (comp seq vector str)
     :g   (comp seq vector count)}))
 
+(t/deftest sequence-foldable
+  (t/testing "Foldl"
+    (t/is (= [3 2 1]
+             (m/foldl (fn [acc v] (into [v] acc)) [] (list 1 2 3))))
+    (t/is (= 6 (m/foldl + 0 (list 1 2 3)))))
+
+  (t/testing "Foldr"
+    (t/is (= [1 2 3]
+             (m/foldr (fn [v acc] (into [v] acc)) [] (list 1 2 3))))
+    (t/is (= 6 (m/foldr + 0 (list 1 2 3))))))
+
+(t/deftest sequence-traversable
+  (t/testing "Traverse"
+    (t/is (= (maybe/just [])
+             (ctx/with-context maybe/context
+               (m/traverse inc-if-even '()))))
+    (t/is (= (maybe/just [3 5])
+             (ctx/with-context maybe/context
+               (m/traverse inc-if-even (list 2 4)))))
+    (t/is (= (maybe/nothing)
+             (ctx/with-context maybe/context
+               (m/traverse inc-if-even (list 1 2)))))))
+
+;; Lazy Sequence
+
+(defn lazy-sequence-gen [g]
+  (gen/fmap #(lazy-seq %) (gen/vector g)))
+
+(defspec lazy-sequence-semigroup 10
+  (lt/semigroup-associativity
+   {:ctx b/lazy-sequence-context
+    :gen (gen/not-empty (lazy-sequence-gen gen/any))}))
+
+(defspec lazy-sequence-monoid 10
+  (lt/monoid-identity-element
+   {:ctx b/lazy-sequence-context
+    :gen (lazy-sequence-gen gen/any)}))
+
+(defspec lazy-sequence-first-functor-law 10
+  (lt/first-functor-law
+   {:gen (lazy-sequence-gen gen/any)}))
+
+(defspec lazy-sequence-second-functor-law 10
+  (lt/second-functor-law
+   {:gen (lazy-sequence-gen gen/any)
+    :f   #(lazy-seq [%])
+    :g   #(lazy-seq [%])}))
+
+(defspec lazy-sequence-applicative-identity 10
+  (lt/applicative-identity-law
+   {:ctx b/lazy-sequence-context
+    :gen (lazy-sequence-gen gen/any)}))
+
+(defspec lazy-sequence-applicative-homomorphism 10
+  (lt/applicative-homomorphism
+   {:ctx b/lazy-sequence-context
+    :gen gen/any
+    :f   (constantly false)}))
+
+(defspec lazy-sequence-applicative-interchange 10
+  (lt/applicative-interchange
+   {:ctx  b/lazy-sequence-context
+    :gen  gen/int
+    :appf (lazy-seq [inc])}))
+
+(defspec lazy-sequence-applicative-composition 10
+  (lt/applicative-composition
+   {:ctx  b/lazy-sequence-context
+    :gen  gen/int
+    :appf (lazy-seq [inc])
+    :appg (lazy-seq [dec])}))
+
+(defspec lazy-sequence-first-monad-law 10
+  (lt/first-monad-law
+   {:ctx b/lazy-sequence-context
+    :mf  #(if % (lazy-seq [%]) (lazy-seq []))}))
+
+(defspec lazy-sequence-second-monad-law 10
+  (lt/second-monad-law {:ctx b/lazy-sequence-context}))
+
+(defspec lazy-sequence-third-monad-law 10
+  (lt/third-monad-law
+   {:ctx b/lazy-sequence-context
+    :f   (comp seq vector str)
+    :g   (comp seq vector count)}))
+
 (t/deftest lazyseq-foldable
   (t/testing "Foldl"
     (t/is (= [3 2 1]

test/cats/core_spec.cljc

@@ -160,7 +160,7 @@
 
     ;; FIXME: uncomment when finishing funcool/cats#77
     #_(t/testing "It can lift a function to a Monad Transformer"
-      (let [maybe-sequence-monad (maybe/maybe-t b/sequence-context)]
+      (let [maybe-sequence-monad (maybe/maybe-t b/lazy-sequence-context)]
         (t/is (= [(maybe/just 1) (maybe/just 2)
                   (maybe/just 3) (maybe/just 4)
                   (maybe/just 5) (maybe/just 6)]
@@ -181,7 +181,7 @@
                (monad+ (maybe/just 1) (maybe/nothing)))))
 
     (t/testing "It can lift a function to a Monad Transformer"
-      (let [maybe-sequence-monad (maybe/maybe-t b/sequence-context)]
+      (let [maybe-sequence-monad (maybe/maybe-t b/lazy-sequence-context)]
         (t/is (= [(maybe/just 1) (maybe/just 2)
                   (maybe/just 3) (maybe/just 4)
                   (maybe/just 5) (maybe/just 6)]
@@ -209,7 +209,7 @@
                ((curry-monad+ (maybe/just 1)) (maybe/just 5))))))
 
   (t/testing "It can lift a function to a Monad Transformer"
-    (let [maybe-sequence-monad (maybe/maybe-t b/sequence-context)
+    (let [maybe-sequence-monad (maybe/maybe-t b/lazy-sequence-context)
           monad+ (m/lift-m 2 add2)]
       (t/is (= [(maybe/just 1) (maybe/just 2)
                 (maybe/just 3) (maybe/just 4)