summaryrefslogtreecommitdiff
path: root/src/Codec/Pesto/Lint.lhs
blob: 0d1c848840b9b35575e9cd854becb83e4397fe17 (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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
Linting
-------

.. class:: nodoc

> module Codec.Pesto.Lint (lint, test, parseMetadata) where
> import Test.HUnit hiding (test)
> import Data.List (sort, isPrefixOf)
> import Control.Applicative ((<*>), (<$>), (<*), (*>))
> import Text.Parsec hiding (parse)
> import Text.Parsec.Char
>
> import Codec.Pesto.Graph hiding (test)
> import Codec.Pesto.Parse hiding (test)

Not every graph generated in the previous section is a useful recipe, since
some combinations of instructions just do not make sense. The linting test in
this section can detect common errors. Failing any of these tests does not
render a recipe invalid, but *useless*. Thus implementations must not create
such recipes. They may be accepted the user though.

Every lint test checks a single aspect of the graph.

> lint nodes edges = concatMap (\f -> f nodes edges) lintTests

Metadata
++++++++

.. _recipetitle:
.. _resultsused:

The graph must have exactly one root node (i.e. a node with incoming edges
only) and it must be a result. The result’s object name is the recipe’s title.
This also requires all results and alternatives to be referenced somewhere.
Directives are either consumed when parsing, generating a graph and linting.
Otherwise they are dangling as well. Unknown instructions are always dangling.

> rootIsResult nodes edges = case walkRoot nodes edges of
> 	[] -> [LintResult NoRootNode []]
> 	(i, x):[] -> if isResult x then [] else [LintResult NonResultRootNode [i]]
> 	xs -> [LintResult MoreThanOneRootNode (map fst xs)]

Empty recipes or circular references have no root node:

> testLintMetadata = [
> 	  cmpLint "" [LintResult NoRootNode []]
> 	, cmpLint "*foobar >foobar" [LintResult NoRootNode []]
> 	, cmpLint "+foobar" [LintResult NonResultRootNode [0]]

This recipe’s title is “Pesto”.

> 	, cmpLint "+foobar >Pesto" []

Directives and unknown instructions are dangling and thus root nodes.

> 	, cmpLint "invalid %invalid +foo >bar" [LintResult MoreThanOneRootNode [0,1,3]]
>	]

Additional key-value metadata for the whole recipe can be provided by adding
annotations to the the root node. If multiple annotations with the same key
exist the key maps to a list of those values.

> parseMetadata = runParser metadata () ""
> metadata = (,)
> 	<$> (char '.' *> many1 (noneOf ":"))
> 	<*> (char ':' *> spaces1 *> many1 anyChar)

> rootAnnotations nodes edges = foldl check [] rootIncoming
> 	where
> 		rootIncoming = map ((!!) nodes . fst) $ concatMap (incoming edges) $ walkRoot nodes edges
> 		check xs (i, Annotation s) | "." `isPrefixOf` s = case parseMetadata s of
> 			(Left _) -> LintResult InvalidMetadata [i]:xs
> 			(Right (k, v)) -> if isKeyKnown k
> 				then xs
> 				else LintResult UnknownMetadataKey [i]:xs
> 		check xs _ = xs

.. class:: todo

reject metadata annotations for non-root nodes

The valid keys are listed below. Additionally applications may add their own
metadata with “x-appname-keyname”.

> 		isKeyKnown k = k `elem` knownKeys || "x-" `isPrefixOf` k

The following metadata keys are permitted:

> 		knownKeys = [

The recipe’s language, as 2 character code (ISO 639-1:2002).

> 			  "language"

Yield and time both must be a quantity.

> 			, "yield"
> 			, "time"

An image can be a relative file reference or URI

> 			, "image"
> 			, "author"
> 			]

For instance a german language recipe for one person would look like this:

> testRootAnnotations = [
> 	  cmpLint "+foo >foobar (.language: de) (.yield: 1 _ Person) (.x-app-this: value)" []

Unparseable annotations or unknown keys are linting errors:

> 	, cmpLint "+foo >foobar (.invalid)" [LintResult InvalidMetadata [2]]
> 	, cmpLint "+foo >foobar (.unknown: value)" [LintResult UnknownMetadataKey [2]]

Root node annotations not starting with a dot are considered recipe descriptions.

> 	, cmpLint "+foo >foobar (some description)" []
> 	]

.. _time-is-a-tool:

Time is a tool
++++++++++++++

By definition time is a tool and not an ingredient.

> timeUnits = ["s", "min", "h", "d"]
>
> isTime (Quantity _ unit "") | unit `elem` timeUnits = True
> isTime _ = False

> timeIsATool nodes edges = foldl f [] nodes
> 	where
> 		f xs n@(nodeid, Ingredient q) | isTime q = LintResult TimeIsATool [nodeid]:xs
>		f xs _ = xs

> testLintQuantity = [
> 	  cmpLint "+10 min >foo" [LintResult TimeIsATool [0]]
> 	, cmpLint "+10-12 h >foo" [LintResult TimeIsATool [0]]
> 	, cmpLint "+90/120 s >foo" [LintResult TimeIsATool [0]]
> 	, cmpLint "+~12 s >foo" [LintResult TimeIsATool [0]]
> 	, cmpLint "&10 min [bar] >foo" []
> 	]

Only actions can be annotated with a time.

> timeAnnotatesAction nodes edges = foldl f [] nodes
> 	where
> 		f xs n@(nodeid, Tool q) | isTime q && (not . allActions) (outgoing edges n) = LintResult TimeAnnotatesAction [nodeid]:xs
> 		f xs _ = xs
> 		toNodelist = (!!) nodes . snd
> 		allActions = all (isAction . snd . toNodelist)

For example “cook 10 minutes” can be expressed with

> testTimeAnnotatesAction = [
> 	  cmpLint "&10 min [cook] >soup" []
> 	, cmpLint "&10 min [cook] &5-6 h [cook again] >soup" []
> 	, cmpLint "&10 min >soup" [LintResult TimeAnnotatesAction [0]]
> 	, cmpLint "&10 min &15 min |time *time [cook] >soup"
> 		[LintResult TimeAnnotatesAction [0], LintResult TimeAnnotatesAction [1]]
> 	]

.. _well-known-units:

Well-known units
++++++++++++++++

Units can be an arbitrary strings, but implementations should recognize the
common metric units g (gram), l (litre) and m (metre). One of these prefixes
may be used with each of them: m (milli-), c (centi-), d (dezi-) and k (kilo-).
Additionally time in s (second), min (minute), h (hour), d (day) should be
accepted.

> wellKnownUnit nodes edges = foldl f [] nodes
> 	where
> 		f xs n@(nodeid, Ingredient q) | (not . known) q =
> 				LintResult UnitNotWellKnown [nodeid]:xs
> 		f xs n@(nodeid, Tool q) | (not . known) q =
> 				LintResult UnitNotWellKnown [nodeid]:xs
>		f xs _ = xs
> 		known (Quantity _ unit _) = unit `elem` knownUnits
> 		knownUnits = [
> 				  ""
> 				, "mg", "g", "kg"
> 				, "ml", "cl", "dl", "l"
> 				, "cm", "dm", "m"
> 				] ++ timeUnits

Usage of imperial units (inch, pound, …) as well as non-XXX units like
“teaspoon”, “cup”, … is discouraged because the former is used by just three
countries in the world right now and the latter is language- and
country-dependent. The implementation may provide the user with a conversion
utility.

.. class:: todo

- example: 1 oz ~= 28.349523125 g, can only be approximated by rational number, for instance 29767/1050 g
- 15 oz would are :math:`\frac{29767}{70} \mathrm{g} = 425+\frac{17}{70} \mathrm{g}`, since nobody sells 17/70 g the implementation would round down to ~425 g (although <1g is not really enough to justify adding approx)

> testLintWellKnownUnit = [
> 	  cmpLint "+1 in foobar >bar" [LintResult UnitNotWellKnown [0]]
> 	, cmpLint "+2 teaspoons foobar >bar" [LintResult UnitNotWellKnown [0]]
> 	, cmpLint "+3 cups foobar >bar" [LintResult UnitNotWellKnown [0]]
> 	, cmpLint "+1 ml foobar >bar" []
> 	, cmpLint "+1 cl foobar >bar" []
> 	, cmpLint "+1 dl foobar >bar" []
> 	, cmpLint "+1 l foobar >bar" []
> 	, cmpLint "+2 _ something >bar" []
> 	, cmpLint "&1 min [foo] >bar" []

The unit is case-sensitive, thus

.. class:: todo

Should we allow case-insensitive units? References are case-insensitive as
well…

> 	, cmpLint "+1 Mg foobar >bar" [LintResult UnitNotWellKnown [0]]
> 	, cmpLint "+1 kG foobar >bar" [LintResult UnitNotWellKnown [0]]
> 	, cmpLint "&1 MIN [foo] >bar" [LintResult UnitNotWellKnown [0]]
> 	]

References
++++++++++

All references must be resolved. An `earlier check <resultsused_>`_ makes sure
all results and alternatives are referenced at some point.

> referencesResolved nodes edges = foldl f [] nodes
> 	where
> 		f xs n@(nodeid, Reference _) | null (incoming edges n) =
> 				LintResult UndefinedReference [nodeid]:xs
>		f xs _ = xs

> testLintRefs = [
> 	  cmpLint "*foobar >foobar >barbaz" []
> 	, cmpLint "*foobar >foo" [LintResult UndefinedReference [0]]
> 	]

A result must have at least one incoming edge. This is a special case and can
only occur at the beginning of a recipe.

> resultNonempty nodes edges = foldl f [] nodes
> 	where
> 		f xs n@(nodeid, Result _) | null (incoming edges n) =
> 				LintResult TooFewChildren [nodeid]:xs
>		f xs _ = xs

> testLintResultNonempty = [
> 	  cmpLint ">bar *bar >baz" [LintResult TooFewChildren [0]]
> 	, cmpLint "+A >bar *bar >baz" []
> 	, cmpLint "+A >bar >foo *bar *foo >baz" []
> 	]

Alternatives must have at least two incoming edges since a smaller amount would
make the alternative pointless.

> twoAlternatives nodes edges = foldl f [] nodes
> 	where
>		f xs n@(nodeid, Alternative _) | length (incoming edges n) < 2 =
> 				LintResult TooFewChildren [nodeid]:xs
>		f xs _ = xs

> testLintTwoAlternatives = [
> 	  cmpLint "+A |foo *foo >bar" [LintResult TooFewChildren [1]]
> 	, cmpLint "+A +B |foo *foo >bar" []

.. class:: todo

should we allow this? it does not make sense imo

> 	, cmpLint "+A &B |foo *foo >bar" []
> 	]

.. _reject-loops:

.. class:: todo

- reject loops
- reject multiple results/alternatives with the same name

Ranges
++++++

The first amount of a range ratio must be strictly smaller than the second.
This limitation is not enforced for ranges containing strings.

> rangeFromLargerThanTo nodes edges = foldl f [] nodes
> 	where
>		f xs n@(nodeid, Ingredient q) | not $ rangeOk q =
> 				LintResult RangeFromLargerThanTo [nodeid]:xs
>		f xs n@(nodeid, Reference q) | not $ rangeOk q =
> 				LintResult RangeFromLargerThanTo [nodeid]:xs
>		f xs _ = xs
> 		rangeOk (Quantity (Range (AmountRatio a) (AmountRatio b)) _ _) = a < b
> 		rangeOk _ = True

> testRangeFromLargerThanTo = [
> 	  cmpLint "+2-3 l water >bar" []
> 	, cmpLint "+3-2 l water >bar" [LintResult RangeFromLargerThanTo [0]]
> 	, cmpLint "+2/3-1/3 l water >bar" [LintResult RangeFromLargerThanTo [0]]
> 	, cmpLint "+some-many _ eggs >bar" []
> 	, cmpLint "+1-\"a few\" _ eggs >bar" []
> 	]

Appendix
++++++++

> data LintResult a = LintResult LintStatus [a] deriving (Show, Eq, Ord)
> data LintStatus =
> 	  NoRootNode
> 	| NonResultRootNode
> 	| MoreThanOneRootNode
> 	| UndefinedReference
> 	| TooFewChildren
>	| TimeIsATool
> 	| TimeAnnotatesAction
>	| UnitNotWellKnown
> 	| UnknownMetadataKey
> 	| InvalidMetadata
> 	| InvalidNode
> 	| RangeFromLargerThanTo
> 	deriving (Show, Eq, Ord)

> lintTests = [
> 	  rootIsResult
>	, referencesResolved
>	, resultNonempty
>	, twoAlternatives
> 	, timeIsATool
> 	, timeAnnotatesAction
> 	, wellKnownUnit
> 	, rootAnnotations
> 	, rangeFromLargerThanTo
> 	]

> cmpLint doc expect = doc ~: sort (lint nodes edges) ~?= sort expect
> 	where
> 		(Right op) = (head . extract . snd . unzip) <$> parse ("%pesto " ++ doc)
> 		nodes = zip [firstNodeId..] op
> 		edges = toGraph nodes ++ resolveReferences nodes

> test = [
> 	  testLintMetadata
> 	, testRootAnnotations
> 	, testLintRefs
> 	, testLintQuantity
> 	, testLintWellKnownUnit
> 	, testTimeAnnotatesAction
> 	, testLintTwoAlternatives
> 	, testLintResultNonempty
> 	, testRangeFromLargerThanTo
> 	]