From 1d63c5147500e10d386f3843ba6930fe533ab4e5 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 9 Aug 2015 10:36:45 +0200 Subject: Chane result and reference argument to quantity MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Now the recipe’s yield can be extracted from the root’s quantity. --- src/Codec/Pesto/Graph.lhs | 4 ++-- src/Codec/Pesto/Lint.lhs | 50 +++++++++++++++++++++++------------------- src/Codec/Pesto/Parse.lhs | 17 +++++++------- src/Codec/Pesto/Parse.lhs-boot | 4 ++-- src/Codec/Pesto/Serialize.lhs | 4 ++-- 5 files changed, 42 insertions(+), 37 deletions(-) (limited to 'src') 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 -- cgit v1.2.3