summaryrefslogtreecommitdiff
path: root/src/lib
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib')
-rw-r--r--src/lib/Codec/Pesto.lhs4
-rw-r--r--src/lib/Codec/Pesto/Graph.lhs100
-rw-r--r--src/lib/Codec/Pesto/Lint.lhs9
3 files changed, 103 insertions, 10 deletions
diff --git a/src/lib/Codec/Pesto.lhs b/src/lib/Codec/Pesto.lhs
index ba8e332..13953f9 100644
--- a/src/lib/Codec/Pesto.lhs
+++ b/src/lib/Codec/Pesto.lhs
@@ -46,7 +46,7 @@ interpreted as described in `RFC 2119`_.
:Version: 1-draft
:License: CC0_
:Website: https://6xq.net/pesto/
-:Source code: https://codeberg.org/ldb/pesto
+:Source code: https://codeberg.org/purplesym/pesto
.. _CC0: https://creativecommons.org/publicdomain/zero/1.0/
@@ -263,7 +263,7 @@ There’s more syntax available to express alternatives (either penne or
tagliatelle), ranges (1–2 l water or approximately 1 liter water), and metadata.
But now you can have a first peek at `my recipe collection`_.
-.. _my recipe collection: https://codeberg.org/ldb/rezepte
+.. _my recipe collection: https://codeberg.org/purplesym/rezepte
.. include:: Pesto/Parse.lhs
.. include:: Pesto/Graph.lhs
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
diff --git a/src/lib/Codec/Pesto/Lint.lhs b/src/lib/Codec/Pesto/Lint.lhs
index edeede7..5d9be7d 100644
--- a/src/lib/Codec/Pesto/Lint.lhs
+++ b/src/lib/Codec/Pesto/Lint.lhs
@@ -10,13 +10,15 @@ Linting
> , parseMetadata
> , extractMetadata
> , Metadata(..)
-> , LintResult(..)) where
+> , LintResult(..)
+> , LintStatus(..)) where
> import Test.HUnit hiding (test, Node)
> import Data.List (sort, isPrefixOf, insert, intersect)
> import Text.Parsec hiding (parse)
> import Data.Char (isSpace, toLower)
> import Data.Ratio ((%))
> import Data.Maybe (fromMaybe)
+> import Data.Either (fromRight)
> import qualified Data.Map.Strict as M
>
> import Codec.Pesto.Graph hiding (test)
@@ -70,6 +72,7 @@ Metadata
The graph’s root node must be a result. It contains yield (amount and unit) and
title (object) of the recipe.
+> extractMetadata :: Nodes Instruction -> Edges -> Maybe [(NodeId, (String, Metadata))]
> extractMetadata nodes edges = case walkRoot nodes edges of
> [(i, Result q@(Quantity _ _ title))] ->
> Just $ (i, ("title", MetaStr title))
@@ -445,8 +448,8 @@ Every lint test checks a single aspect of the graph.
> withGraph doc f = f nodes edges
> 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 = toGraph nodes ++ resolveReferences nodes
> cmpLint doc expect = withGraph doc (\nodes edges -> doc ~: sort (lint nodes edges) ~?= sort expect)
generated by cgit v1.2.3 (git 2.46.0) at 2026-01-05 10:18:33 +0000