aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/project.lux
blob: fdf778f28bd1ec809e71aacb26bf5c4d4e706a2d (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
97
98
99
100
(.using
  [library
   [lux "*"
    ["_" test {"+" Test}]
    [abstract
     [monad {"+" do}]
     [\\specification
      ["$[0]" equivalence]
      ["$[0]" monoid]]]
    [control
     ["[0]" try ("[1]#[0]" functor)]
     ["[0]" exception]]
    [data
     ["[0]" product]
     ["[0]" text ("[1]#[0]" equivalence)]]
    [math
     ["[0]" random {"+" Random} ("[1]#[0]" monad)]
     [number
      ["n" nat]]]]]
  [//
   ["@[0]" profile]]
  [\\program
   ["[0]" /
    ["/[1]" // "_"
     ["[1]" profile]]]])

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

(def: .public random
  (Random /.Project)
  (do random.monad
    [[name profile] ..profile]
    (in (/.project name profile))))

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

                 (_.cover [/.file]
                          (|> /.file
                              (text#= "")
                              not))
                 (do random.monad
                   [[super_name super_profile] ..profile
                    [dummy_name dummy_profile] (random.only (|>> product.left (text#= super_name) not)
                                                            ..profile)
                    [sub_name sub_profile] (random.only (function (_ [name profile])
                                                          (and (not (text#= super_name name))
                                                               (not (text#= dummy_name name))))
                                                        ..profile)
                    fake_name (random.only (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 composite)
                                      (/.project super_name super_profile)
                                      (/.project dummy_name dummy_profile)
                                      (/.project sub_name (with@ //.#parents (list super_name) sub_profile)))
                          circular ($_ (# /.monoid composite)
                                       (/.project super_name (with@ //.#parents (list sub_name) super_profile))
                                       (/.project dummy_name dummy_profile)
                                       (/.project sub_name (with@ //.#parents (list super_name) sub_profile)))]]
                   ($_ _.and
                       (_.cover [/.profile]
                                (and (|> (/.profile project super_name)
                                         (try#each (# //.equivalence = super_profile))
                                         (try.else false))
                                     (|> (/.profile project dummy_name)
                                         (try#each (# //.equivalence = dummy_profile))
                                         (try.else false))
                                     (|> (/.profile project sub_name)
                                         (try#each (# //.equivalence = (# //.monoid composite sub_profile super_profile)))
                                         (try.else false))))
                       (_.cover [/.unknown_profile]
                                (case (/.profile project fake_name)
                                  {try.#Success _}
                                  false

                                  {try.#Failure error}
                                  (exception.match? /.unknown_profile error)))
                       (_.cover [/.circular_dependency]
                                (case (/.profile circular sub_name)
                                  {try.#Success _}
                                  false

                                  {try.#Failure error}
                                  (exception.match? /.circular_dependency error)))
                       ))
                 ))))