1 files changed, 95 insertions, 5 deletions

diff --git a/src/lib/Codec/Pesto/Graph.lhs b/src/lib/Codec/Pesto/Graph.lhs
index 43142b6..b959d59 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,10 @@ 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 Data.Either (fromRight)
 >
 > import Codec.Pesto.Parse hiding (test)
 
@@ -155,7 +159,9 @@ These are helper functions:
 > 		consumeStack (_, s, edges) i =
 > 			let
 > 				stack = dropWhile null s
-> 				(top:sx) = if null stack then [[]] else stack
+> 				alwaysStack = if null stack then [[]] else stack
+> 				top = head alwaysStack
+> 				sx = tail alwaysStack
 > 			in (Just i, []:top:sx, edgesTo i top ++ edges)
 > 		edgesTo i = map (\x -> (x, i))
 
@@ -264,13 +270,83 @@ 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
 ++++++++
 
 > runGraphWith f doc expect = sort edges ~?= sort expect
 > 	where
-> 		(Right op) = (head . extract . snd . unzip) <$> parse ("%pesto " ++ doc)
-> 		nodes = zip [firstNodeId..] op
+> 		op = (head . extract . snd . unzip) <$> parse ("%pesto " ++ doc)
+> 		nodes = zip [firstNodeId..] (fromRight (error "unreachable") op)
 > 		edges = f nodes
 > cmpGraph = runGraphWith toGraph
 > cmpGraphRef = runGraphWith resolveReferences
@@ -290,12 +366,26 @@ Find graph’s root node(s), that is a node without outgoing edges:
 Get all nodes with edges pointing towards nodeid
 
 > incomingEdges edges nodeid = filter ((==) nodeid . snd) edges
+
+> incomingNodes :: Nodes a -> Edges -> NodeId -> Nodes a
 > incomingNodes nodes edges nodeid = map ((!!) nodes . fst) $ incomingEdges edges 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