path: root/src/lib/Codec/Pesto/Lint.lhs

.. _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, insert, intersect)
> import Text.Parsec hiding (parse)
> import Data.Char (isSpace, toLower)
> import Data.Ratio ((%))
> import Data.Maybe (fromMaybe)
> import qualified Data.Map.Strict as M
>
> 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 do 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
++++++++++++++++

.. _resultsused:

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 CircularLoop [0, 1], 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
++++++++

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
> 		[(i, Result q@(Quantity _ _ title))] ->
> 			Just $ (i, ("title", MetaStr title))
> 				:(i, ("yield", MetaQty q))
> 				:foldl f [] (incomingNodes nodes edges i)
> 		_ -> 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 (i, Tool qty) | isTime qty = (i, ("time", MetaQty qty)):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 = [

The title, description, yield and time are implicit.

> 			  "title"
> 			, "description"
> 			, "yield"
> 			, "time"

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

> 			, "language"

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:

> testMetadata = [
> 	  cmpLintMeta "+foo &2 min >1 _ foobar (language: de) (x-app-key: value)"
> 		[]
> 		(Just [(2, ("title", MetaStr "foobar"))
> 			, (2, ("yield", MetaQty (Quantity (Exact (AmountRatio (1%1))) "" "foobar")))
> 			, (1, ("time", MetaQty (Quantity (Exact (AmountRatio (2%1))) "min" "")))
> 			, (3, ("language", MetaStr "de"))
> 			, (4, ("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" []
> 	]

Actions or results can be annotated like this to indicate how long a
particular action or result is *expected* to take (i.e., the action
“peel potatoes” or result “peeled potatoes” take two minutes)
or how long the action is supposed to be executed (i.e., cook for five
minutes). More time annotations improve the software’s scheduling
capabilities.

> timeAnnotatesActionResult nodes edges = foldl f [] nodes
> 	where
> 		f xs (nodeid, Tool q) | isViolation q nodeid = LintResult TimeAnnotatesActionResult [nodeid]:xs
> 		f xs _ = xs
> 		isViolation q nodeid = isTime q && (not . allActionsResults) (outgoingEdges edges nodeid)
> 		toNodelist = (!!) nodes . snd
> 		allActionsResults = all (actionOrResult . snd . toNodelist)
> 		actionOrResult n = isAction n || isResult n

For example, “cook 10 minutes” can be expressed with:

> testTimeAnnotatesActionResult = [
> 	  cmpLint "&10 min [cook] >soup" []

Or “soup takes ten minutes” as

> 	, cmpLint "&10 min >soup" []

It does not make sense to annotate alternatives though, since durations
can already be expressed with approximate quantities.

> 	, cmpLint "&5 min &10 min |bar *bar >soup"
> 		[ LintResult TimeAnnotatesActionResult [0]
> 		, LintResult TimeAnnotatesActionResult [1]]
> 	]

.. _well-known-units:

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

Units can be arbitrary strings, but implementations should recognize the
standard metric units g (gram), l (liter), and m (meter). 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), and 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, …), non-standard
units like “teaspoon,” “cup,” or similar 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.

> 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

> 	, 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>`_ ensures
all results and alternatives are referenced at some point.

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

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

Results and alternatives must not have duplicate names, so collect
their lower-case object names into a ``Map`` and flag those which
reference multiple nodes.

> uniqueNames nodes _ = M.foldl f [] nameMap
> 	where
> 		f xs fnodes | length fnodes > 1 = LintResult DuplicateReferenceName fnodes:xs
> 		f xs _ = xs
> 		nameMap = foldl buildMap M.empty nodes
> 		buildMap m (nodeid, Result qty) = M.insertWith append (getObject qty) [nodeid] m
> 		buildMap m (nodeid, Alternative qty) = M.insertWith append (getObject qty) [nodeid] m
> 		buildMap m _ = m
> 		getObject (Quantity _ _ object) = map toLower object
> 		append a b = insert (head a) b

> testUniqueNames = [
> 	  cmpLint "+a >x +b >y *x *y >foo" []
> 	, cmpLint "+a >x +b >x *x >y" [LintResult DuplicateReferenceName [1, 3]]
> 	, cmpLint "+a >x +b +c |x *x >y" [LintResult DuplicateReferenceName [1, 4]]
> 	, cmpLint "+a >1 _ foo +a >2 _ FOO +a >3 _ foO *Foo >y"
> 		[LintResult DuplicateReferenceName [1, 3, 5]]
> 	]

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 (nodeid, Result _) | null (incomingEdges edges nodeid) =
> 				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 (nodeid, Alternative _) | length (incomingEdges edges nodeid) < 2 =
> 				LintResult TooFewChildren [nodeid]:xs
> 		f xs _ = xs

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

.. _reject-loops:

References cannot loop because, well, you cannot cook something and
use an ingredient you have not made yet. It is possible to branch out
and merge again if an ingredient is split into multiple parts
and added to different outputs.

> circularLoops nodes edges = map (LintResult CircularLoop) circles
> 	where
> 		allReferences = foldl referenceNodes [] nodes
> 		referenceNodes xs (nodeid, Reference _) = nodeid:xs
> 		referenceNodes xs _ = xs
> 		circles = filter (not . null) $ map (visitIncoming [] . singleton) allReferences
> 		singleton x = [x]
> 		visitIncoming _ [] = []
> 		visitIncoming visited next = case length (intersect visited nextNext) of
> 			0 -> visitIncoming nextVisited nextNext
> 			_ -> nextVisited
> 			where
> 				nextVisited = visited ++ next
> 				nextNext = map fst $ concat $ map (incomingNodes nodes edges) next

> testLintCircularLoops = [
> 	  cmpLint "*y >x *x >y >foobar"
> 		[LintResult CircularLoop [0, 3, 2, 1] , LintResult CircularLoop [2, 1, 0, 3]]
> 	, cmpLint "*z >x *x >y *y >z *z >foobar" [
> 		  LintResult CircularLoop [0, 5, 4, 3, 2, 1]
> 		, LintResult CircularLoop [2, 1, 0, 5, 4, 3]
> 		, LintResult CircularLoop [4, 3, 2, 1, 0, 5]
> 		, LintResult CircularLoop [6, 5, 4, 3, 2, 1, 0]
> 		]
> 	, cmpLint "+a >foobar *1/2 _ foobar >x *1/2 _ foobar >y *x *y >final" []
> 	, cmpLint "+a >foobar *1/2 _ foobar >x *x *1/2 _ foobar >final" []
> 	]

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
> 	| DuplicateReferenceName
> 	| CircularLoop
> 	| TooFewChildren
> 	| TimeIsATool
> 	| TimeAnnotatesActionResult
> 	| 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
> 	, uniqueNames
> 	, circularLoops
> 	, resultNonempty
> 	, twoAlternatives
> 	, timeIsATool
> 	, timeAnnotatesActionResult
> 	, 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
> 	, testUniqueNames
> 	, testLintCircularLoops
> 	, testLintQuantity
> 	, testLintWellKnownUnit
> 	, testTimeAnnotatesActionResult
> 	, testLintTwoAlternatives
> 	, testLintResultNonempty
> 	, testRangeFromLargerThanTo
> 	]