diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/exe/Main.lhs | 8 | ||||
| -rw-r--r-- | src/lib/Codec/Pesto/Graph.lhs | 89 |
2 files changed, 91 insertions, 6 deletions
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 |