.. _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 `_). > , "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 > ]