[gnunet] 01/01: Add (gnu gnunet monad).

[Ludovic Courtès]

civodul pushed a commit to branch wip-monad
in repository gnunet.

commit 5a1748a48c4e75922e42f7464c914692bf504ae9
Author: Ludovic Courtès <address@hidden>
Date:   Fri Nov 13 22:43:13 2015 +0100

    Add (gnu gnunet monad).
    
    * gnu/gnunet/monad.scm, examples/monad/identity.in: New files.
    * configure.ac: Check for (guix monads).  Substitute
      examples/monad/identity.
    * Makefile.am (MODULES): Add gnu/gnunet/monad.scm.
---
 .dir-locals.el             |    4 ++
 .gitignore                 |    1 +
 Makefile.am                |    1 +
 configure.ac               |    7 +++
 examples/monad/identity.in |   47 ++++++++++++++++
 gnu/gnunet/monad.scm       |  128 ++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 188 insertions(+), 0 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..20bcee8
--- /dev/null
+++ b/.dir-locals.el
@@ -0,0 +1,4 @@
+((nil . ((fill-column . 78)
+        (indent-tabs-mode . nil)))
+ (scheme-mode
+  . ((eval . (put 'run-with-scheduler 'scheme-indent-function 1)))))
diff --git a/.gitignore b/.gitignore
index 32a0fbd..9e91003 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ Makefile.in
 /examples/publish
 /examples/search
 /examples/search-ns
+/examples/monad/identity
diff --git a/Makefile.am b/Makefile.am
index 93c7029..f691680 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -20,6 +20,7 @@ MODULES =                                     \
   system/foreign/unions-read-write.scm         \
   system/foreign/unions.scm                    \
   gnu/gnunet/common.scm                                \
+  gnu/gnunet/monad.scm                          \
   gnu/gnunet/scheduler.scm                     \
   gnu/gnunet/binding-utils.scm                 \
   gnu/gnunet/container/metadata.scm            \
diff --git a/configure.ac b/configure.ac
index b4405c1..4e27047 100644
--- a/configure.ac
+++ b/configure.ac
@@ -34,6 +34,11 @@ AC_SUBST([guilemoduledir])
 
 AC_CACHE_SAVE
 
+GUILE_MODULE_AVAILABLE([have_guix_monads], [(guix monads)])
+if test "x$have_guix_monads" != "xyes"; then
+  AC_MSG_ERROR([(guix monads) module could not be found])
+fi
+
 PKG_CHECK_MODULES([GNUNETUTIL], [gnunetutil])
 PKG_CHECK_MODULES([GNUNETFS], [gnunetfs])
 PKG_CHECK_MODULES([GNUNETIDENTITY], [gnunetidentity])
@@ -57,4 +62,6 @@ AC_CONFIG_FILES([examples/publish], [chmod +x 
examples/publish])
 AC_CONFIG_FILES([examples/search], [chmod +x examples/search])
 AC_CONFIG_FILES([examples/search-ns], [chmod +x examples/search-ns])
 
+AC_CONFIG_FILES([examples/monad/identity], [chmod +x examples/monad/identity])
+
 AC_OUTPUT
diff --git a/examples/monad/identity.in b/examples/monad/identity.in
new file mode 100644
index 0000000..3fa720f
--- /dev/null
+++ b/examples/monad/identity.in
@@ -0,0 +1,47 @@
address@hidden@ \
+-e (@\ (gnunet-identity)\ main) -L . -s
+!#
+;;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;;;
+;;;; This program is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnunet-identity)
+  #:use-module (guix monads)
+  #:use-module (gnu gnunet monad)
+  #:use-module (gnu gnunet configuration)
+  #:use-module (gnu gnunet identity)
+  #:use-module (ice-9 match)
+  #:export (main))
+
+(define (main args)
+  (define config-file "~/.gnunet/gnunet.conf")
+  (define config (load-configuration config-file))
+
+  (run-with-scheduler config
+    (mlet* %task-monad ((id (identity-service config)))
+      (match id
+        ((ego name)
+         ;; Only print the public key of egos that have an associated
+         ;; nickname.
+         (if name
+             (begin
+               (format #t "~a - ~a~%"
+                       name
+                       (ecdsa-public-key->string (ego-public-key ego)))
+               (return id))
+             (skip)))))))
+
+;; Local Variables:
+;; mode: scheme
+;; End:
diff --git a/gnu/gnunet/monad.scm b/gnu/gnunet/monad.scm
new file mode 100644
index 0000000..6c76f5e
--- /dev/null
+++ b/gnu/gnunet/monad.scm
@@ -0,0 +1,128 @@
+;;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;;;
+;;;; This program is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu gnunet monad)
+  #:use-module (guix monads)
+  #:use-module (gnu gnunet scheduler)
+  #:use-module (gnu gnunet identity)
+  #:use-module (gnu gnunet fs)
+  #:use-module (ice-9 match)
+  #:export (%task-monad
+            async
+            delayed
+            skip
+            run-with-scheduler
+
+            identity-service
+            file-sharing-service))
+
+;;; Commentary:
+;;;
+;;; This module provides the "task monad," a monad that abstracts over GNUnet
+;;; tasks and callbacks.  The goal is to "invert inversion of control" (IoC)
+;;; so as to obtain more readable programs.  This is essentially
+;;; continuation-passing style (CPS) in disguise.  Some monadic procedures
+;;; such as 'identity-service' may return zero or several times because they
+;;; correspond to callbacks.
+;;;
+;;; Code:
+
+(define-inlinable (task-return value)
+  (lambda (cont)
+    (cont value)))
+
+(define-inlinable (task-bind mvalue proc)
+  (lambda (cont)
+    (mvalue (lambda (value)
+              ((proc value) cont)))))
+
+(define-monad %task-monad
+  (bind   task-bind)
+  (return task-return))
+
+;; ((with-monad %task-monad
+;;    (>>= (return 42)
+;;         (lift1 1+ %task-monad)
+;;         (lift1 1+ %task-monad)
+;;         (lambda (x)
+;;           (return (* 2 x)))))
+;;  pk)
+
+(define (run-with-scheduler config mvalue)
+  "Run MVALUE, a monadic value in %TASK-MONAD, using CONFIG.  In practice this
+starts the GNUnet scheduler and runs the given tasks."
+  (call-with-scheduler config
+                       (lambda (x)
+                         (mvalue identity))))
+
+(define-inlinable (task thunk)
+  "Return the result of THUNK as a monadic value.  THUNK will be invoked from
+within a GNUnet task."
+  (lambda (cont)
+    (add-task! (lambda (_)
+                 (cont (thunk))))))
+
+(define-syntax-rule (async exp)
+  "Return the result of EXP as evaluated in an asynchronous task."
+  (task (lambda () exp)))
+
+(define (delayed-task delay thunk)
+  (lambda (cont)
+    (add-task! (lambda (_)
+                 (cont (thunk)))
+               #:delay delay)))
+
+(define-syntax-rule (delayed usec exp)
+  "Return the result of EXP after waiting for USEC microseconds."
+  (delayed-task usec (lambda () exp)))
+
+(define* (skip #:optional value)
+  "Skip the continuation and return VALUE."
+  (lambda (cont)
+    value))
+
+
+;;;
+;;; Monadic wrappers.
+;;;
+
+(define* (identity-service config)
+  "Return, zero or more times, an ego/name or ego/#f tuple corresponding to
+CONFIG."
+  (lambda (cont)
+    (define service
+      (open-identity-service config
+                             (lambda (ego name)
+                               (if (not ego)
+                                   (add-task! (lambda (_)
+                                                (close-identity-service 
service)))
+                                   (cont (list ego name))))))
+    service))
+
+(define* (file-sharing-service config name)
+  "Return, zero or more times, a handle/info/status tuple from the publication
+service."
+  (lambda (cont)
+    (define service
+      (open-filesharing-service config name
+                                (lambda (info status)
+                                  (match status
+                                    ((#:publish #:stopped)
+                                     (close-filesharing-service! service))
+                                    (_
+                                     (cont (list service info status)))))))
+    service))
+
+;;; monad.scm ends here