From f7047f1c3966bd1727c1a3729295def3c9913ab8 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 29 Jul 2017 11:18:12 -0400
Subject: - Added Functor, Applicative and Monad implementations for Lazy.

---
 stdlib/source/lux/data/lazy.lux    | 25 +++++++++++++++++++++---
 stdlib/test/test/lux/data/lazy.lux | 40 +++++++++++++++++++++++++++++++++-----
 2 files changed, 57 insertions(+), 8 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux
index 1f4566eee..d2533644a 100644
--- a/stdlib/source/lux/data/lazy.lux
+++ b/stdlib/source/lux/data/lazy.lux
@@ -1,7 +1,9 @@
 (;module:
   lux
   (lux [io]
-       (control monad)
+       (control functor
+                applicative
+                monad)
        (concurrency ["A" atom])
        [macro]
        (macro ["s" syntax #+ syntax:])
@@ -12,8 +14,7 @@
 
   (def: #hidden (freeze' generator)
     (All [a] (-> (-> [] a) (Lazy a)))
-    (let [cache (: (A;Atom (Maybe ($ +0)))
-                   (A;atom #;None))]
+    (let [cache (A;atom (: (Maybe ($ +0)) #;None))]
       (@model (function [_]
                 (case (io;run (A;get cache))
                   (#;Some value)
@@ -32,3 +33,21 @@
   (do @
     [g!_ (macro;gensym "_")]
     (wrap (list (` (freeze' (function [(~ g!_)] (~ expr))))))))
+
+(struct: #export _ (Functor Lazy)
+  (def: (map f fa)
+    (freeze (f (thaw fa)))))
+
+(struct: #export _ (Applicative Lazy)
+  (def: functor Functor<Lazy>)
+
+  (def: (wrap a)
+    (freeze a))
+
+  (def: (apply ff fa)
+    (freeze ((thaw ff) (thaw fa)))))
+
+(struct: #export _ (Monad Lazy)
+  (def: applicative Applicative<Lazy>)
+
+  (def: join thaw))
diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux
index bf395bcfa..926157a07 100644
--- a/stdlib/test/test/lux/data/lazy.lux
+++ b/stdlib/test/test/lux/data/lazy.lux
@@ -1,14 +1,14 @@
 (;module:
   lux
   (lux [io]
-       (control ["M" monad #+ do Monad])
+       (control [monad #+ do Monad])
        (data ["&" lazy])
-       ["R" math/random])
+       ["r" math/random])
   lux/test)
 
 (context: "Lazy."
-  [left R;nat
-   right R;nat
+  [left r;nat
+   right r;nat
    #let [lazy (&;freeze (n.* left right))
          expected (n.* left right)]]
   ($_ seq
@@ -17,7 +17,37 @@
                  (&;thaw lazy)))
       (test "Lazy values only evaluate once."
             (and (not (is expected
-                          (: Nat (&;thaw lazy))))
+                          (&;thaw lazy)))
                  (is (&;thaw lazy)
                      (&;thaw lazy))))
       ))
+
+(context: "Functor, Applicative, Monad."
+  [sample r;nat]
+  ($_ seq
+      (test "Functor map."
+            (|> (&;freeze sample)
+                (:: &;Functor<Lazy> map n.inc)
+                &;thaw
+                (n.= (n.inc sample))))
+
+      (test "Applicative wrap."
+            (|> sample
+                (:: &;Applicative<Lazy> wrap)
+                &;thaw
+                (n.= sample)))
+      
+      (test "Applicative apply."
+            (let [(^open "&/") &;Applicative<Lazy>]
+              (|> (&/apply (&/wrap n.inc) (&/wrap sample))
+                  &;thaw
+                  (n.= (n.inc sample)))))
+      
+      (test "Monad."
+            (|> (do &;Monad<Lazy>
+                  [f (wrap n.inc)
+                   a (wrap sample)]
+                  (wrap (f a)))
+                &;thaw
+                (n.= (n.inc sample))))
+      ))
-- 
cgit v1.2.3