aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/project.lux
blob: ab8cc438f75d1ce285e65b6d11d7e8f0fe38ea10 (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 /._)
      (_.with-cover [/.Project /.project]
        ($_ _.and
            (_.with-cover [/.equivalence]
              ($equivalence.spec /.equivalence ..random))
            (_.with-cover [/.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)))
                  ))
            ))))