Chane result and reference argument to quantity

Now the recipe’s yield can be extracted from the root’s quantity.

5 files changed, 42 insertions, 37 deletions

diff --git a/src/Codec/Pesto/Graph.lhs b/src/Codec/Pesto/Graph.lhs
index ed02b50..8ef384a 100644
--- a/src/Codec/Pesto/Graph.lhs
+++ b/src/Codec/Pesto/Graph.lhs
@@ -206,8 +206,8 @@ to the reference in question is created.
 > findTarget nodes (Reference (Quantity _ _ a)) = map fst $ filter (isTarget a) nodes
 > 	where
 > 		lc = map toLower
-> 		isTarget dest (_, Result x) = lc x == lc dest
->		isTarget dest (_, Alternative x) = lc x == lc dest
+> 		isTarget dest (_, Result (Quantity _ _ x)) = lc x == lc dest
+>		isTarget dest (_, Alternative (Quantity _ _ x)) = lc x == lc dest
 > 		isTarget _ _ = False
 > findTarget _ _ = []
 
diff --git a/src/Codec/Pesto/Lint.lhs b/src/Codec/Pesto/Lint.lhs
index 76253e8..4e7efa5 100644
--- a/src/Codec/Pesto/Lint.lhs
+++ b/src/Codec/Pesto/Lint.lhs
@@ -7,9 +7,9 @@ Linting
 > import Test.HUnit hiding (test, Node)
 > import Data.List (sort, isPrefixOf)
 > import Control.Applicative ((<*>), (<$>), (*>))
-> import Control.Monad (liftM)
 > import Text.Parsec hiding (parse)
 > import Data.Char (isSpace)
+> import Data.Ratio ((%))
 >
 > import Codec.Pesto.Graph hiding (test)
 > import Codec.Pesto.Parse hiding (test)
@@ -51,10 +51,6 @@ Empty recipes or circular references have no root node:
 > 	, cmpLint "+foobar"
 >		[LintResult NonResultRootNode [0], LintResult NoMetadata []]
 
-This recipe’s title is “Pesto”.
-
-> 	, cmpLint "+foobar >Pesto" []
-
 Directives and unknown instructions are dangling and thus root nodes.
 
 > 	, cmpLint "invalid %invalid +foo >bar"
@@ -70,12 +66,14 @@ Metadata
 
 root node can be alternative too?
 
-The graph’s root node must be a result and its object value is used as recipe
-title.
+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 title)] ->
-> 			Just $ (i, ("title", title)):foldl f [] (incomingNodes nodes edges n)
+> 		[n@(i, Result q@(Quantity _ _ title))] ->
+> 			Just $ (i, ("title", MetaStr title))
+> 				:(i, ("yield", MetaQty q))
+> 				:foldl f [] (incomingNodes nodes edges n)
 >		_ -> Nothing
 > 	where
 
@@ -85,8 +83,8 @@ 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", s)):xs
-> 				Right kv -> (i, kv):xs
+> 				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
@@ -143,29 +141,31 @@ 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 >foobar (language: de) (yield: 1 _ Person) (x-app-key: value)"
+> 	  cmpLintMeta "+foo >1 Portion foobar (language: de) (x-app-key: value)"
 >		[]
->		(Just [(1, ("title", "foobar"))
->			, (2, ("language", "de"))
-> 			, (3, ("yield", "1 _ Person"))
-> 			, (4, ("x-app-key", "value"))])
+>		(Just [(1, ("title", MetaStr "foobar"))
+> 			, (1, ("yield", MetaQty (Quantity (Exact (AmountRatio (1%1))) "Portion" "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", "foobar"))
-> 			, (2, ("unknown-key", "value"))])
+> 		(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", "foobar"))
-> 			, (2, ("description", " some description "))
-> 			, (3, ("description", "another one: with colon"))
-> 			, (4, ("another", "valid key-value"))])
+> 		(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:
@@ -398,10 +398,14 @@ Every lint test checks a single aspect of the graph.
 
 > 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
-> 		, liftM sort (extractMetadata nodes edges) ~?= liftM sort expectMeta
+> 		, extractMetadata nodes edges ~?= expectMeta
 > 		])
+> strQuantity = Quantity (Exact (AmountStr "")) ""
 
 > test = [
 > 	  testConnectivity
diff --git a/src/Codec/Pesto/Parse.lhs b/src/Codec/Pesto/Parse.lhs
index d411906..1777aa2 100644
--- a/src/Codec/Pesto/Parse.lhs
+++ b/src/Codec/Pesto/Parse.lhs
@@ -51,8 +51,8 @@ The following instructions are supported:
 > 	| Tool Quantity
 > 	| Action String
 > 	| Reference Quantity
-> 	| Result Object
-> 	| Alternative Object
+> 	| Result Quantity
+> 	| Alternative Quantity
 > 	| Directive String
 > 	| Unknown String
 > 	deriving (Show, Eq)
@@ -95,8 +95,8 @@ whitespace characters and then consumes an object or a quantity.
 > oparg ident cont = char ident *> spaces *> cont
 > ingredient = oparg '+' (Ingredient <$> quantity)
 > tool = oparg '&' (Tool <$> quantity)
-> result = oparg '>' (Result <$> object)
-> alternative = oparg '|' (Alternative <$> object)
+> result = oparg '>' (Result <$> quantity)
+> alternative = oparg '|' (Alternative <$> quantity)
 > reference = oparg '*' (Reference <$> quantity)
 
 Additionally there are two special instructions. Directives are similar to the
@@ -118,11 +118,11 @@ Below are examples for these instructions:
 > 	  cmpInstruction "+100 g flour"
 > 	      (Right (Ingredient (Quantity (Exact (AmountRatio (100%1))) "g" "flour")))
 > 	, cmpInstruction "&oven"
-> 	      (Right (Tool (Quantity (Exact (AmountStr "")) "" "oven")))
-> 	, cmpInstruction ">dough" (Right (Result "dough"))
-> 	, cmpInstruction "|trimmings" (Right (Alternative "trimmings"))
+> 	      (Right (Tool (strQuantity "oven")))
+> 	, cmpInstruction ">dough" (Right (Result (strQuantity "dough")))
+> 	, cmpInstruction "|trimmings" (Right (Alternative (strQuantity "trimmings")))
 > 	, cmpInstruction "*fish"
-> 	      (Right (Reference (Quantity (Exact (AmountStr "")) "" "fish")))
+> 	      (Right (Reference (strQuantity "fish")))
 > 	, cmpInstruction3 "% invalid" (Right (Directive "invalid")) "%invalid"
 > 	, cmpInstruction3 "* \t\n 1 _ cheese"
 > 	      (Right (Reference (Quantity (Exact (AmountRatio (1%1))) "" "cheese")))
@@ -367,6 +367,7 @@ Wrap qstr test in AmountStr to aid serialization test
 > cmpInstruction3 = cmpParseSerialize instruction
 
 > exactQuantity a b c = Right (Quantity (Exact a) b c)
+> strQuantity = Quantity (Exact (AmountStr "")) ""
 
 > test = [
 > 	  "quantity" ~: testQuantityOverloaded ++ testQuantityApprox ++ testQuantityAmount ++ testQuantityRatio
diff --git a/src/Codec/Pesto/Parse.lhs-boot b/src/Codec/Pesto/Parse.lhs-boot
index 50d1b2a..9096ad7 100644
--- a/src/Codec/Pesto/Parse.lhs-boot
+++ b/src/Codec/Pesto/Parse.lhs-boot
@@ -6,8 +6,8 @@
 > 	| Tool Quantity
 > 	| Action String
 > 	| Reference Quantity
-> 	| Result Object
-> 	| Alternative Object
+> 	| Result Quantity
+> 	| Alternative Quantity
 > 	| Directive String
 > 	| Unknown String
 > data Quantity = Quantity Approximately Unit Object
diff --git a/src/Codec/Pesto/Serialize.lhs b/src/Codec/Pesto/Serialize.lhs
index 56babb4..f07e871 100644
--- a/src/Codec/Pesto/Serialize.lhs
+++ b/src/Codec/Pesto/Serialize.lhs
@@ -28,8 +28,8 @@ Finally transform linear stream of instructions into a string again:
 > 	serialize (Tool q) = '&':serialize q
 > 	serialize (Action s) = quote '[' ']' s
 > 	serialize (Reference q) = '*':serialize q
-> 	serialize (Result s) = '>':serializeQstr s
-> 	serialize (Alternative s) = '|':serializeQstr s
+> 	serialize (Result q) = '>':serialize q
+> 	serialize (Alternative q) = '|':serialize q
 > 	serialize (Directive s) = '%':serializeQstr s
 > 	serialize (Unknown s) = s