summaryrefslogtreecommitdiff
path: root/src/lib/Codec/Pesto/Lint.lhs
blob: 919eeefe47faa94685def8ca1ddae77a77e5f4ab (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
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
.. _linting:

Linting
-------

.. class:: nodoc

> module Codec.Pesto.Lint (lint
> 	, test
> 	, parseMetadata
> 	, extractMetadata
> 	, Metadata(..)
> 	, LintResult(..)) where
> import Test.HUnit hiding (test, Node)
> import Data.List (sort, isPrefixOf)
> import Text.Parsec hiding (parse)
> import Data.Char (isSpace)
> import Data.Ratio ((%))
> import Data.Maybe (fromMaybe)
>
> import Codec.Pesto.Graph hiding (test)
> import Codec.Pesto.Parse hiding (test)

Not every graph generated in the previous section is a useful recipe. Some
instruction sequences just do not make sense. The tests in this section can
detect those. Failing any of them does not render a stream of instructions or
graph invalid. They just does not describe a *useful* recipe. Thus
implementations must not generate or export such documents. However they should
accept input that fails any of the tests and warn the user about the failure.

Additionally this section provides guidance on how to use the instructions
provided by the Pesto language properly.

Graph properties
++++++++++++++++

- weakly connected, no dangling nodes/subgraphs
- acyclic

The graph must have exactly one root node (i.e. a node with incoming edges
only).  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 []]
> 	(_, Result _):[] -> []
> 	(i, _):[] -> [LintResult NonResultRootNode [i]]
> 	xs -> [LintResult MoreThanOneRootNode (map fst xs)]

Empty recipes or circular references have no root node:

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

Directives and unknown instructions are dangling and thus root nodes.

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

Metadata
++++++++

.. _resultsused:

.. class:: todo

root node can be alternative too?

The graph’s root node must be a result. It contains yield (amount and unit) and
title (object) of the recipe.

> extractMetadata nodes edges = case walkRoot nodes edges of
> 		[n@(i, Result q@(Quantity _ _ title))] ->
> 			Just $ (i, ("title", MetaStr title))
> 				:(i, ("yield", MetaQty q))
> 				:foldl f [] (incomingNodes nodes edges n)
>		_ -> Nothing
> 	where

Additional key-value metadata for the whole recipe can be added as annotations
to the root node. If multiple annotations with the same key exist the key maps
to a list of those values. Annotations that are unparseable key-value pairs are
added as recipe description instead.

> 		f xs (i, Annotation s) = case parseMetadata s of
> 				Left _ -> (i, ("description", MetaStr s)):xs
> 				Right (k, v) -> (i, (k, MetaStr v)):xs
> 		f xs _ = xs

Key and value are separated by a colon. Keys must not contain whitespace or the
colon char. A value may be empty.

> parseMetadata = runParser metadata () ""
> metadata = let keychars = satisfy (\x -> not (isSpace x) && x /= ':') in (,)
> 	<$> many1 keychars
> 	<*> (char ':' *> spaces *> many anyChar)

> lintMetadata nodes edges = case extractMetadata nodes edges of
> 		Just result -> foldl checkKey [] result
> 		Nothing -> [LintResult NoMetadata []]
> 	where
> 		checkKey xs (_, (k, _)) | isKeyKnown k = xs
> 		checkKey xs (i, _) = LintResult UnknownMetadataKey [i]:xs

Valid metadata keys are listed below. Additionally applications may add keys by
prefixing them with “x-myapp-”, thus an application called “basil” adding
“some-key” would use the full key “x-basil-some-key”.

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

The following metadata keys are permitted:

> 		knownKeys = [

Both, title and description, are implicit.

>			  "title"
> 			, "description"

The recipe’s language, as 2 character code (`ISO 639-1
<http://www.loc.gov/standards/iso639-2/php/English_list.php>`_).

> 			, "language"

Yield and time both must be a quantity.

> 			, "yield"
> 			, "time"

An image can be a relative file reference or URI

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

.. class:: todo

Check the metadata’s value format. I.e. yield/time must be quantity

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

> testMetadata = [
> 	  cmpLintMeta "+foo >1 ml foobar (language: de) (x-app-key: value)"
>		[]
>		(Just [(1, ("title", MetaStr "foobar"))
> 			, (1, ("yield", MetaQty (Quantity (Exact (AmountRatio (1%1))) "ml" "foobar")))
>			, (2, ("language", MetaStr "de"))
> 			, (3, ("x-app-key", MetaStr "value"))])

Unparseable annotations or unknown keys are linting errors:

> 	, cmpLintMeta "+foo >foobar (unknown-key: value)"
> 		[LintResult UnknownMetadataKey [2]]
> 		(Just [(1, ("title", MetaStr "foobar"))
>			, (1, ("yield", MetaQty (strQuantity "foobar")))
> 			, (2, ("unknown-key", MetaStr "value"))])

Root node annotations not containing a parseable key-value pair are assigned
the key “description”.

> 	, cmpLintMeta "+foo >foobar ( some description ) (another one: with colon) (another:     valid key-value)"
> 		[LintResult UnknownMetadataKey [4]]
> 		(Just [(1, ("title", MetaStr "foobar"))
> 			, (1, ("yield", MetaQty (strQuantity "foobar")))
> 			, (2, ("description", MetaStr " some description "))
> 			, (3, ("description", MetaStr "another one: with colon"))
> 			, (4, ("another", MetaStr "valid key-value"))])
> 	]

.. _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 _ = foldl f [] nodes
> 	where
> 		f xs (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. It can be used to indicate how long
a certain action is *expected* to take (i.e. peeling potatoes takes two
minutes) or how long the action is supposed to be executed (i.e. cook five
minutes). More time annotations improve the software’s scheduling capabilities.

> timeAnnotatesAction nodes edges = foldl f [] nodes
> 	where
> 		f xs n@(nodeid, Tool q) | isTime q && (not . allActions) (outgoingEdges 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 _ = foldl f [] nodes
> 	where
> 		extractQty (Ingredient q) = Just q
> 		extractQty (Tool q) = Just q
> 		extractQty (Result q) = Just q
> 		extractQty (Alternative q) = Just q
> 		extractQty (Reference q) = Just q
> 		extractQty _ = Nothing
> 		f xs (nodeid, instr) | fromMaybe False (extractQty instr >>= (return . not . known)) =
> 				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 (incomingEdges 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 (incomingEdges 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 (incomingEdges 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 _ = foldl f [] nodes
> 	where
>		f xs (nodeid, Ingredient q) | not $ rangeOk q =
> 				LintResult RangeFromLargerThanTo [nodeid]:xs
>		f xs (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 = LintResult LintStatus [NodeId] deriving (Show, Eq, Ord)
> data LintStatus =
> 	  NoRootNode
> 	| NonResultRootNode
> 	| MoreThanOneRootNode
> 	| UndefinedReference
> 	| TooFewChildren
>	| TimeIsATool
> 	| TimeAnnotatesAction
>	| UnitNotWellKnown
> 	| InvalidNode
> 	| RangeFromLargerThanTo
> 	| NoMetadata
> 	| UnknownMetadataKey
> 	deriving (Show, Eq, Ord)

Every lint test checks a single aspect of the graph.

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

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

> withGraph doc f = f nodes edges
>	where
> 		(Right op) = (head . extract . snd . unzip) <$> parse ("%pesto " ++ doc)
> 		nodes = zip [firstNodeId..] op
> 		edges = toGraph nodes ++ resolveReferences nodes

> cmpLint doc expect = withGraph doc (\nodes edges -> doc ~: sort (lint nodes edges) ~?= sort expect)


> data Metadata = MetaQty Quantity | MetaStr String deriving (Show, Eq)

> cmpLintMeta doc expectLint expectMeta = withGraph doc (\nodes edges -> doc ~: [
> 		  sort (lint nodes edges) ~?= sort expectLint
> 		, extractMetadata nodes edges ~?= expectMeta
> 		])
> strQuantity = Quantity (Exact (AmountStr "")) ""

> test = [
> 	  testConnectivity
> 	, testMetadata
> 	, testLintRefs
> 	, testLintQuantity
> 	, testLintWellKnownUnit
> 	, testTimeAnnotatesAction
> 	, testLintTwoAlternatives
> 	, testLintResultNonempty
> 	, testRangeFromLargerThanTo
> 	]