summaryrefslogtreecommitdiff
path: root/src/lib/Codec
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/Codec')
-rw-r--r--src/lib/Codec/Pesto/Graph.lhs89
-rw-r--r--src/lib/Codec/Pesto/Lint.lhs60
2 files changed, 122 insertions, 27 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 01:22:03 +0000