;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; 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 (test-monads) #:use-module (guix tests) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix grafts) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:
aboutsummaryrefslogtreecommitdiff
blob: 019111c1674b859d25479d147ef712f18739c342 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
;; -*- mode: scheme; -*-
;; This is an operating system configuration template
;; for a "bare bones" setup for an ASUS C201PA.

(use-modules (gnu) (gnu bootloader depthcharge))
(use-service-modules networking ssh)
(use-package-modules linux screen)

(operating-system
  (host-name "komputilo")
  (timezone "Europe/Berlin")
  (locale "en_US.utf8")

  ;; Assuming /dev/mmcblk0p1 is the kernel partition, and
  ;; "my-root" is the label of the target root file system.
  (bootloader (bootloader-configuration
                (bootloader depthcharge-bootloader)
                (targets '("/dev/mmcblk0p1"))))

  ;; The ASUS C201PA requires a very particular kernel to boot,
  ;; as well as the following arguments.
  (kernel linux-libre-arm-generic)
  (kernel-arguments '("console=tty1"))

  ;; We do not need any special modules for initrd, and the
  ;; PrawnOS kernel does not include many of the normal ones.
  (initrd-modules '())

  (file-systems (cons (file-system
                        (device (file-system-label "my-root"))
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))

  ;; This is where user accounts are specified.  The "root"
  ;; account is implicit, and is initially created with the
  ;; empty password.
  (users (cons (user-account
                (name "alice")
                (comment "Bob's sister")
                (group "users")

                ;; Adding the account to the "wheel" group
                ;; makes it a sudoer.  Adding it to "audio"
                ;; and "video" allows the user to play sound
                ;; and access the webcam.
                (supplementary-groups '("wheel"
                                        "audio" "video"))
                (home-directory "/home/alice"))
               %base-user-accounts))

  ;; Globally-installed packages.
  (packages (cons screen %base-packages))

  ;; Add services to the baseline: a DHCP client and
  ;; an SSH server.
  (services (append (list (service dhcp-client-service-type)
                          (service openssh-service-type
                                   (openssh-configuration
                                    (port-number 2222))))
                    %base-services)))
(return 1) (return 2) (return 3)))) (mlet monad ((lst lst)) (return (equal? '(1 2 3) lst))))))) %monads %monad-run)) (test-assert "anym" (every (lambda (monad run) (eq? (run (with-monad monad (anym monad (lift1 (lambda (x) (and (odd? x) 'odd!)) monad) (append (make-list 1000 0) (list 1 2))))) 'odd!)) %monads %monad-run)) (test-equal "set-current-state" (list '(a a d) 'd) (values->list (run-with-state (mlet* %state-monad ((init (current-state)) (init2 (set-current-state 'b))) (mbegin %state-monad (set-current-state 'c) (set-current-state 'd) (mlet %state-monad ((last (current-state))) (return (list init init2 last))))) 'a))) (test-equal "state-push etc." (list '((z . 2) (p . (1)) (a . (1))) '(2 1)) (values->list (run-with-state (mbegin %state-monad (state-push 1) ;(1) (state-push 2) ;(2 1) (mlet* %state-monad ((z (state-pop)) ;(1) (p (current-state)) (a (state-push z))) ;(2 1) (return `((z . ,z) (p . ,p) (a . ,a))))) '()))) (test-end "monads")