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.
This commit is contained in:
Ludovic Courtès
parent
d12167ab3c
commit
5a1748a48c
|
|
@ -0,0 +1,4 @@
|
|||
((nil . ((fill-column . 78)
|
||||
(indent-tabs-mode . nil)))
|
||||
(scheme-mode
|
||||
. ((eval . (put 'run-with-scheduler 'scheme-indent-function 1)))))
|
||||
|
|
@ -21,3 +21,4 @@ Makefile.in
|
|||
/examples/publish
|
||||
/examples/search
|
||||
/examples/search-ns
|
||||
/examples/monad/identity
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,47 @@
|
|||
#!@GUILE@ \
|
||||
-e (@\ (gnunet-identity)\ main) -L . -s
|
||||
!#
|
||||
;;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;;
|
||||
;;;; 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:
|
||||
|
|
@ -0,0 +1,128 @@
|
|||
;;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;;
|
||||
;;;; 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
|
||||
Loading…
Reference in New Issue