summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Codec/Pesto/Graph.lhs4
-rw-r--r--src/Codec/Pesto/Lint.lhs50
-rw-r--r--src/Codec/Pesto/Parse.lhs17
-rw-r--r--src/Codec/Pesto/Parse.lhs-boot4
-rw-r--r--src/Codec/Pesto/Serialize.lhs4
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 08:51:16 +0000