;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix 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. ;;; ;;; GNU Guix 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 GNU Guix. If not, see . (define-module (gnu packages animation) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix utils) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages boost) #:use-module (gnu packages compression) #:use-module (gnu packages fontutils) #:use-module (gnu packages glib) #:use-module (gnu packages gnome) #:use-module (gnu packages graphics) #:use-module (gnu packages gtk) #:use-module (gnu packages image) #:use-module (gnu packages imagemagick) #:use-module (gnu packages pkg-config) #:use-module (gnu packages video)) (define-public etl (package (name "etl") (version "0.04.19") (source (origin (method url-fetch) ;; Keep this synchronized with the synfig release version. (uri (string-append "mirror://sourceforge/synfig/releases/" "1.0.2/source/ETL-" version ".tar.gz")) (sha256 (base32 "070c70slizrklq1gbgja8m49xfmq65wlcd6hz6418cpx0wd4r55s")))) (build-system gnu;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2022 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix 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. ;;; ;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-monads) #:use-module (guix tests) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages base) #:select (coreutils)) #:use-module (ice-9 match) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64)) ;; Test the (guix monads) module. (define %store (open-connection-for-tests)) ;; Globally disable grafts because they can trigger early builds. (%graft? #f) (define %monads (list %identity-monad %store-monad %state-monad)) (define %monad-run (list identity (cut run-with-store %store <>) (cut run-with-state <> '()))) (define-syntax-rule (values->list exp) (call-with-values (lambda () exp) list)) (test-begin "monads") (test-assert "monad?" (and (every monad? %monads) (every (compose procedure? monad-bind) %monads) (every (compose procedure? monad-return) %monads))) ;; The 3 "monad laws": <http://www.haskell.org/haskellwiki/Monad_laws>. (test-assert "left identity" (every (lambda (monad run) (let ((number (random 777))) (with-monad monad (define (f x) (return (* (1+ number) 2))) (= (run (>>= (return number) f)) (run (f number)))))) %monads %monad-run)) (test-assert "right identity" (every (lambda (monad run) (with-monad monad (let ((number (return (random 777)))) (= (run (>>= number return)) (run number))))) %monads %monad-run)) (test-assert "associativity" (every (lambda (monad run) (with-monad monad (define (f x) (return (+ 1 x))) (define (g x) (return (* 2 x))) (let ((number (return (random 777)))) (= (run (>>= (>>= number f) g)) (run (>>= number (lambda (x) (>>= (f x) g)))))))) %monads %monad-run)) (test-assert "lift" (every (lambda (monad run) (let ((f (lift1 1+ monad)) (g (apply lift1 1+ (list monad)))) (with-monad monad (let ((number (random 777))) (= (run (>>= (return number) f)) (run (>>= (return number) g)) (1+ number)))))) %monads %monad-run)) (test-assert ">>= with more than two arguments" (every (lambda (monad run) (let ((1+ (lift1 1+ monad)) (2* (lift1 (cut * 2 <>) monad))) (with-monad monad (let ((number (random 777))) (= (run (>>= (return number) 1+ 1+ 1+ 2* 2* 2*)) (* 8 (+ number 3))))))) %monads %monad-run)) (test-assert "mbegin" (every (lambda (monad run) (with-monad monad (let* ((been-there? #f) (number (mbegin monad (return 1) (begin (set! been-there? #t) (return 2)) (return 3)))) (and (= (run number) 3) been-there?)))) %monads %monad-run)) (test-assert "mparameterize" (let ((parameter (make-parameter 'outside))) (every (lambda (monad run) (equal? (run (mlet monad ((outer (return (parameter))) (inner (mparameterize monad ((parameter 'inside)) (return (parameter))))) (return (list outer inner (parameter))))) '(outside inside outside))) %monads %monad-run))) (test-assert "mlet* + text-file + package-file" (run-with-store %store (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) (file (text-file "monadic" guile))) (return (equal? (call-with-input-file file get-string-all) guile))) #:guile-for-build (package-derivation %store %bootstrap-guile)