aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/licentia/input.lux
blob: 48617f045f3c3b38f81df9affd3fbe6fde992d16 (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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
(.module:
  [lux #*
   [abstract
    [monad (#+ do)]]
   [control
    ["." exception (#+ exception:)]
    ["." parser
     ["." json (#+ Parser)]]]
   [data
    [text
     ["%" format (#+ format)]]
    [number
     ["n" nat]
     ["i" int]
     ["f" frac]]]]
  [//
   [license (#+ Identification
                Termination
                Liability
                Distribution
                Commercial
                Extension
                Entity Black-List
                URL Attribution
                License)
    ["." time (#+ Period)]
    ["." copyright]]])

(def: identification
  (Parser Identification)
  (json.object
    ($_ parser.and
        (json.field "name" json.string)
        (json.field "version" json.string))))

(exception: #export (cannot-use-fractional-amount {amount Frac})
  (exception.report
   ["Amount" (%.frac amount)]))

(exception: #export (cannot-use-negative-amount {amount Int})
  (exception.report
   ["Amount" (%.int amount)]))

(def: amount
  (Parser Nat)
  (do parser.monad
    [amountF json.number
     #let [amountI (f.int amountF)]
     _ (parser.assert (exception.construct cannot-use-fractional-amount amountF)
                      (f.= amountF
                           (i.frac amountI)))
     _ (parser.assert (exception.construct cannot-use-negative-amount amountI)
                      (i.> +0 amountI))]
    (wrap (.nat amountI))))

(exception: #export (invalid-period {period (Period Nat)})
  (exception.report
   ["Start" (%.nat (get@ #time.start period))]
   ["End" (%.nat (get@ #time.end period))]))

(def: period
  (Parser (Period Nat))
  (json.object
    (do parser.monad
      [start (json.field "start" ..amount)
       end (json.field "end" ..amount)
       #let [period {#time.start start
                     #time.end end}]
       _ (parser.assert (exception.construct invalid-period period)
                        (n.<= end start))]
      (wrap period))))

(def: copyright-holder
  (Parser copyright.Holder)
  (json.object
    ($_ parser.and
        (json.field "name" json.string)
        (json.field "period" ..period))))

(def: termination
  (Parser Termination)
  (json.object
    ($_ parser.and
        (json.field "patent retaliation?" json.boolean)
        (json.field "termination period" ..amount)
        (json.field "grace period" ..amount))))

(def: liability
  (Parser Liability)
  (json.object
    ($_ parser.and
        (json.field "can accept?" json.boolean)
        (json.field "disclaim high risk?" json.boolean))))

(def: distribution
  (Parser Distribution)
  (json.object
    ($_ parser.and
        (json.field "can re-license?" json.boolean)
        (json.field "can multi-license?" json.boolean))))

(def: commercial
  (Parser Commercial)
  (json.object
    ($_ parser.and
        (json.field "can sell?" json.boolean)
        (json.field "require contributor credit?" json.boolean)
        (json.field "allow contributor endorsement?" json.boolean))))

(def: extension
  (Parser Extension)
  (json.object
    ($_ parser.and
        (json.field "same license?" json.boolean)
        (json.field "must be distinguishable?" json.boolean)
        (json.field "notification period" (json.nullable ..period))
        (json.field "must describe modifications?" json.boolean))))

(def: entity
  (Parser Entity)
  json.string)

(def: black-list
  (Parser Black-List)
  (json.object
    ($_ parser.and
        (json.field "justification" (json.nullable json.string))
        (json.field "entities" (json.array (parser.many ..entity))))))

(def: url
  (Parser URL)
  json.string)

(def: attribution
  (Parser Attribution)
  (json.object
    ($_ parser.and
        (json.field "copyright-notice" json.string)
        (json.field "phrase" (json.nullable json.string))
        (json.field "url" ..url)
        (json.field "image" (json.nullable ..url)))))

(def: #export license
  (Parser License)
  (json.object
    ($_ parser.and
        (json.field "copyright-holders" (json.array (parser.many ..copyright-holder)))
        (json.field "identification" (json.nullable ..identification))
        (json.field "termination" ..termination)
        (json.field "liability" ..liability)
        (json.field "distribution" ..distribution)
        (json.field "commercial" ..commercial)
        (json.field "extension" ..extension)
        (json.field "black-lists" (json.array (parser.some ..black-list)))
        (json.field "attribution" (json.nullable ..attribution)))))