diff options
| -rw-r--r-- | README.rst | 8 | ||||
| -rw-r--r-- | src/exe/Main.lhs | 8 | ||||
| -rw-r--r-- | src/lib/Codec/Pesto/Graph.lhs | 89 | ||||
| -rw-r--r-- | src/lib/Codec/Pesto/Lint.lhs | 60 |
4 files changed, 129 insertions, 36 deletions
@@ -1,14 +1,12 @@ Pesto ===== -.. image:: https://github.com/PromyLOPh/pesto/workflows/build/badge.svg - Pesto is a text-based human-editable and machine-transformable cooking recipe interchange format. -For more information see the latest draft_, which is rendered from its Literate +For more information see the latest `rendered version`_ or its Literate Haskell sources_. -.. _draft: https://6xq.net/pesto/ -.. _sources: https://github.com/PromyLOPh/pesto/blob/master/src/lib/Codec/Pesto.lhs +.. _rendered version: https://6xq.net/pesto/ +.. _sources: https://codeberg.org/ldb/pesto/src/branch/master/src/lib/Codec/Pesto.lhs diff --git a/src/exe/Main.lhs b/src/exe/Main.lhs index dc360fd..ae663ad 100644 --- a/src/exe/Main.lhs +++ b/src/exe/Main.lhs @@ -8,7 +8,7 @@ User interface > import Data.List (intercalate) > > import Codec.Pesto.Parse (parse, Instruction (Ingredient), Quantity (..)) -> import Codec.Pesto.Graph (extract, toGraph, firstNodeId, resolveReferences) +> import Codec.Pesto.Graph (extract, toGraph, firstNodeId, resolveReferences, extractIngredients, mergeQuantity) > import Codec.Pesto.Lint (lint, extractMetadata, Metadata(..), LintResult (LintResult)) > import Codec.Pesto.Serialize (serialize) @@ -87,10 +87,10 @@ ingredients Extract ingredients and print them in CSV format. This does not take alternatives into account yet. -> runIngredients stream = mapM_ (putStrLn . csvQty) $ reverse $ foldl getIngredient [] stream +> runIngredients stream = mapM_ (putStrLn . csvQty) $ ingredients > where -> getIngredient xs (_, Ingredient q) = q:xs -> getIngredient xs _ = xs +> (nodes, _) = streamToGraph stream +> ingredients = mergeQuantity $ extractIngredients nodes > printMeta (_, (key, MetaStr value)) = putStrLn $ key ++ "=" ++ value > printMeta (_, (key, MetaQty q)) = putStrLn $ key ++ "=" ++ csvQty q diff --git a/src/lib/Codec/Pesto/Graph.lhs b/src/lib/Codec/Pesto/Graph.lhs index 43142b6..5628ec3 100644 --- a/src/lib/Codec/Pesto/Graph.lhs +++ b/src/lib/Codec/Pesto/Graph.lhs @@ -16,6 +16,8 @@ Language semantics > , resolveReferences > , test > , extract +> , extractIngredients +> , mergeQuantity > , NodeId > , Node > , Nodes @@ -23,8 +25,9 @@ Language semantics > , Edges > ) where > import Data.Char (toLower) -> import Data.List (sort, nub) +> import Data.List (sort, nub, sortOn) > import Test.HUnit hiding (test, Node) +> import Data.Ratio ((%), Ratio) > > import Codec.Pesto.Parse hiding (test) @@ -264,6 +267,76 @@ results with the same name). They are permitted at this stage, but rejected > , cmpGraphRef "|foobar *foobar >foobar *foobar" [(0, 1), (0, 3), (2, 1), (2, 3)] > ] +Quantities +++++++++++ + +.. Does not really fit here. Move? + +Lists of quantities, for instance for a shopping basket, can be extracted and merged. + +> extractIngredients :: [Node Instruction] -> [Quantity] +> extractIngredients nodes = foldl f [] nodes +> where +> f xs (_, Ingredient q) = q:xs +> f xs _ = xs + +> mergeQuantity :: [Quantity] -> [Quantity] +> mergeQuantity ingredients = reverse $ foldl foldQty [] sortedIngredients +> where +> sortedIngredients = sortOn sortKey ingredients +> sortKey (Quantity _ b c) = (c, b) +> foldQty ((Quantity (Exact (AmountRatio prevAmount)) prevUnit prevObject):xs) +> (Quantity (Exact (AmountRatio qamount)) qunit qobject) +> | prevObject == qobject && prevUnit == qunit +> = (Quantity (Exact (AmountRatio (prevAmount + qamount))) qunit qobject):xs +> foldQty ((Quantity (Exact (AmountStr "")) prevUnit prevObject):xs) +> (Quantity (Exact (AmountStr "")) qunit qobject) +> | prevObject == qobject && prevUnit == qunit +> = (Quantity (Exact (AmountStr "")) qunit qobject):xs +> foldQty xs x = x:xs + +> testQuantity :: [Test] +> testQuantity = [ + +Quantities are merged when their objects and units match. + +> cmpMerge [ +> exactRatioQuantity (1%1) "kg" "apples" +> , exactRatioQuantity (2%1) "kg" "apples" +> , exactRatioQuantity (1%2) "" "bananas" +> , exactRatioQuantity (3%4) "" "bananas" +> , exactRatioQuantity (5%1) "" "peas" +> , exactRatioQuantity (200%1) "g" "peas" +> ] +> [ +> exactRatioQuantity (3%1) "kg" "apples" +> , exactRatioQuantity (5%4) "" "bananas" +> , exactRatioQuantity (5%1) "" "peas" +> , exactRatioQuantity (200%1) "g" "peas" +> ] + +Objects without any quantity can also be merged. + +> , cmpMerge [ +> strQuantity "apples" +> , strQuantity "apples" +> ] +> [ strQuantity "apples" ] + +The merged quantities are sorted. + +> , cmpMerge [ +> strQuantity "b" +> , strQuantity "c" +> , strQuantity "a" +> ] +> [ +> strQuantity "a" +> , strQuantity "b" +> , strQuantity "c" +> ] +> ] + Appendix ++++++++ @@ -295,7 +368,19 @@ Get all nodes with edges pointing towards nodeid > outgoingEdges edges nodeid = filter ((==) nodeid . fst) edges > outgoingNodes nodes edges nodeid = map ((!!) nodes . snd) $ outgoingEdges edges nodeid -> test = ["graph" ~: testGraph, "ref" ~: testRef, "extract" ~: testExtract] +> test = [ +> "graph" ~: testGraph +> , "ref" ~: testRef +> , "extract" ~: testExtract +> , "quantity" ~: testQuantity +> ] + +> cmpMerge value expected = (mergeQuantity value) ~?= expected +> strQuantity = Quantity (Exact (AmountStr "")) "" +> exactRatioQuantity :: Ratio Integer -> Unit -> Object -> Quantity +> exactRatioQuantity qamount qunit qobject = +> Quantity (Exact (AmountRatio qamount)) qunit qobject + > third (_, _, x) = x diff --git a/src/lib/Codec/Pesto/Lint.lhs b/src/lib/Codec/Pesto/Lint.lhs index 3ecdfa1..edeede7 100644 --- a/src/lib/Codec/Pesto/Lint.lhs +++ b/src/lib/Codec/Pesto/Lint.lhs @@ -86,6 +86,7 @@ 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 @@ -113,21 +114,18 @@ The following metadata keys are permitted: > knownKeys = [ -The title, description and yield are implicit. +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" -Time both must be a time-unit quantity. - -> , "time" - An image can be a relative file reference or URI > , "image" @@ -137,12 +135,13 @@ An image can be a relative file reference or URI For instance a german language recipe for one person would look like this: > testMetadata = [ -> cmpLintMeta "+foo >1 _ foobar (language: de) (x-app-key: value)" +> cmpLintMeta "+foo &2 min >1 _ foobar (language: de) (x-app-key: value)" > [] -> (Just [(1, ("title", MetaStr "foobar")) -> , (1, ("yield", MetaQty (Quantity (Exact (AmountRatio (1%1))) "" "foobar"))) -> , (2, ("language", MetaStr "de")) -> , (3, ("x-app-key", MetaStr "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: @@ -189,26 +188,37 @@ By definition, time is a tool and not an ingredient. > , cmpLint "&10 min [bar] >foo" [] > ] -Only actions can be annotated like this. It can be used to indicate how long -a particular 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 for five -minutes). More time annotations improve the software’s scheduling capabilities. +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. -> timeAnnotatesAction nodes edges = foldl f [] nodes +> timeAnnotatesActionResult nodes edges = foldl f [] nodes > where -> f xs (nodeid, Tool q) | isTime q && (not . allActions) (outgoingEdges edges nodeid) = LintResult TimeAnnotatesAction [nodeid]:xs +> 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 -> allActions = all (isAction . snd . toNodelist) +> allActionsResults = all (actionOrResult . snd . toNodelist) +> actionOrResult n = isAction n || isResult n For example, “cook 10 minutes” can be expressed with: -> testTimeAnnotatesAction = [ +> testTimeAnnotatesActionResult = [ > 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]] + +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: @@ -407,7 +417,7 @@ Appendix > | CircularLoop > | TooFewChildren > | TimeIsATool -> | TimeAnnotatesAction +> | TimeAnnotatesActionResult > | UnitNotWellKnown > | InvalidNode > | RangeFromLargerThanTo @@ -427,7 +437,7 @@ Every lint test checks a single aspect of the graph. > , resultNonempty > , twoAlternatives > , timeIsATool -> , timeAnnotatesAction +> , timeAnnotatesActionResult > , wellKnownUnit > , lintMetadata > , rangeFromLargerThanTo @@ -458,7 +468,7 @@ Every lint test checks a single aspect of the graph. > , testLintCircularLoops > , testLintQuantity > , testLintWellKnownUnit -> , testTimeAnnotatesAction +> , testTimeAnnotatesActionResult > , testLintTwoAlternatives > , testLintResultNonempty > , testRangeFromLargerThanTo |