From 295dd897297722d07ec2ce5fb82e323fe495c775 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 24 Aug 2020 17:09:34 +0200 Subject: GHC 8.8, cabal 3, pandoc 2.10 compatibility Move files around to separate Pesto (the library) and Pesto (the executables). Fixes for pandoc API changes. --- src/Codec/Pesto/Lint.lhs | 433 ----------------------------------------------- 1 file changed, 433 deletions(-) delete mode 100644 src/Codec/Pesto/Lint.lhs (limited to 'src/Codec/Pesto/Lint.lhs') diff --git a/src/Codec/Pesto/Lint.lhs b/src/Codec/Pesto/Lint.lhs deleted file mode 100644 index 81cb5d6..0000000 --- a/src/Codec/Pesto/Lint.lhs +++ /dev/null @@ -1,433 +0,0 @@ -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 `_ 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 -> ] - -- cgit v1.2.3