aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/project.lux
blob: 5e26b63de1794351d318dde927e074d3a61903cc (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)]]
   [math
    ["." random (#+ Random) ("#\." monad)]
    [number
     ["n" nat]]]]
  [//
   ["@." 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)))
                       ))
                 ))))