From 1ee02b261a10c381c7ee6d3c9363e26dd8f5ebda Mon Sep 17 00:00:00 2001
From: Correl Roush <correl@gmail.com>
Date: Wed, 9 Jul 2014 01:28:48 -0400
Subject: [PATCH] Add state monad and behaviour

---
 src/state-monad.lfe                  | 47 ++++++++++++++++++++++++++++
 src/state.lfe                        | 12 +++++++
 test/unit/unit-state-monad-tests.lfe | 12 +++++++
 3 files changed, 71 insertions(+)
 create mode 100644 src/state-monad.lfe
 create mode 100644 src/state.lfe
 create mode 100644 test/unit/unit-state-monad-tests.lfe

diff --git a/src/state-monad.lfe b/src/state-monad.lfe
new file mode 100644
index 0000000..22eb1b2
--- /dev/null
+++ b/src/state-monad.lfe
@@ -0,0 +1,47 @@
+(defmodule state-monad
+  (behaviour monad)
+  (behaviour state)
+  (export (return 1)
+          (fail 1)
+          (run 2)
+          (>>= 2)
+          (get 0)
+          (put 1)
+          (modify 1)
+          (modify-and-return 1)
+          (exec 2)
+          (eval 2)))
+
+(defun return (x) (lambda (state) (tuple x state)))
+(defun fail (x) (throw (tuple 'error x)))
+
+(defun run (m state)
+  (funcall m state))
+
+(defun >>= (m f)
+  (lambda (state)
+    (let (((tuple x s) (run m state)))
+      (run (funcall f x) s))))
+
+(defun put (state)
+  (lambda (_) (tuple '() state)))
+
+(defun get ()
+  (lambda (state)
+    (tuple state state)))
+
+(defun modify (f)
+  (lambda (state)
+    (tuple '() (funcall f state))))
+
+(defun modify-and-return (f)
+  (lambda (state)
+    (let ((newstate (funcall f state)))
+      (tuple newstate newstate))))
+
+(defun eval (m state)
+  (let (((tuple x _s) (run m state)))
+    x))
+(defun exec (m state)
+  (let (((tuple _x s) (run m state)))
+    s))
diff --git a/src/state.lfe b/src/state.lfe
new file mode 100644
index 0000000..797241b
--- /dev/null
+++ b/src/state.lfe
@@ -0,0 +1,12 @@
+(defmodule state
+  (export (behaviour_info 1)))
+
+(defun behaviour_info
+  (('callbacks) (list #(run 2)
+                      #(get 0)
+                      #(put 1)
+                      #(modify 1)
+                      #(modify-and-return 1)
+                      #(exec 2)
+                      #(eval 2)))
+  ((_) 'undefined))
\ No newline at end of file
diff --git a/test/unit/unit-state-monad-tests.lfe b/test/unit/unit-state-monad-tests.lfe
new file mode 100644
index 0000000..87e9211
--- /dev/null
+++ b/test/unit/unit-state-monad-tests.lfe
@@ -0,0 +1,12 @@
+(defmodule unit-state-monad-tests
+  (export all)
+  (import
+    (from lfeunit-util
+      (check-failed-assert 2)
+      (check-wrong-assert-exception 2))))
+
+(include-lib "deps/lfeunit/include/lfeunit-macros.lfe")
+(include-lib "include/monads.lfe")
+(include-lib "include/monad-tests.lfe")
+
+(test-monad 'state-monad)