aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/project.lux
blob: 4ea00a3c42a63523c44b96dccfec6870e182a681 (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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    {[0 #spec]
     [/
      ["$." equivalence]
      ["$." monoid]]}]
   [control
    ["." try ("#\." functor)]
    ["." exception]]
   [data
    ["." product]
    ["." text ("#\." equivalence)]
    [number
     ["n" nat]]]
   [math
    ["." random (#+ Random) ("#\." monad)]]]
  [//
   ["@." profile]]
  {#program
   ["." /
    ["/#" // #_
     ["#" profile]]]})

(def: profile
  (Random [//.Name //.Profile])
  (|> @profile.random
      (random\map (set@ #//.parents (list)))
      (random.and (random.ascii/alpha 1))))

(def: #export random
  (Random /.Project)
  (do random.monad
    [[name profile] ..profile]
    (wrap (/.project name profile))))

(def: #export test
  Test
  (<| (_.covering /._)
      (_.for [/.Project /.project]
             ($_ _.and
                 (_.for [/.equivalence]
                        ($equivalence.spec /.equivalence ..random))
                 (_.for [/.monoid]
                        ($monoid.spec /.equivalence /.monoid ..random))

                 (do random.monad
                   [[super-name super-profile] ..profile
                    [dummy-name dummy-profile] (random.filter (|>> product.left (text\= super-name) not)
                                                              ..profile)
                    [sub-name sub-profile] (random.filter (function (_ [name profile])
                                                            (and (not (text\= super-name name))
                                                                 (not (text\= dummy-name name))))
                                                          ..profile)
                    fake-name (random.filter (function (_ name)
                                               (and (not (text\= super-name name))
                                                    (not (text\= dummy-name name))
                                                    (not (text\= sub-name name))))
                                             (random.ascii/alpha 1))
                    #let [project ($_ (\ /.monoid compose)
                                      (/.project super-name super-profile)
                                      (/.project dummy-name dummy-profile)
                                      (/.project sub-name (set@ #//.parents (list super-name) sub-profile)))
                          circular ($_ (\ /.monoid compose)
                                       (/.project super-name (set@ #//.parents (list sub-name) super-profile))
                                       (/.project dummy-name dummy-profile)
                                       (/.project sub-name (set@ #//.parents (list super-name) sub-profile)))]]
                   ($_ _.and
                       (_.cover [/.profile]
                                (and (|> (/.profile super-name project)
                                         (try\map (\ //.equivalence = super-profile))
                                         (try.default false))
                                     (|> (/.profile dummy-name project)
                                         (try\map (\ //.equivalence = dummy-profile))
                                         (try.default false))
                                     (|> (/.profile sub-name project)
                                         (try\map (\ //.equivalence = (\ //.monoid compose sub-profile super-profile)))
                                         (try.default false))))
                       (_.cover [/.unknown-profile]
                                (case (/.profile fake-name project)
                                  (#try.Success _)
                                  false

                                  (#try.Failure error)
                                  (exception.match? /.unknown-profile error)))
                       (_.cover [/.circular-dependency]
                                (case (/.profile sub-name circular)
                                  (#try.Success _)
                                  false

                                  (#try.Failure error)
                                  (exception.match? /.circular-dependency error)))
                       ))
                 ))))