diff --git a/src/Roux/Parser.hs b/src/Roux/Parser.hs index 47546df..ac503ee 100644 --- a/src/Roux/Parser.hs +++ b/src/Roux/Parser.hs @@ -8,6 +8,7 @@ module Roux.Parser ( parseCookFile, ) where +import Control.Monad (join) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Text (Text) import qualified Data.Text as T @@ -100,7 +101,7 @@ stripSectionHeader t = -- Step-level parser (Parsec) -- --------------------------------------------------------------------------- --- | Parse a single step block (plain text only for now). +-- | Parse a single step block. pStepBlock :: Parser Step pStepBlock = do items <- P.many pStepItem @@ -110,6 +111,10 @@ pStepBlock = do pStepItem :: Parser StepItem pStepItem = pLineBreak + P.<|> P.try pRecipeRef + P.<|> P.try pIngredient + P.<|> P.try pCookware + P.<|> P.try pTimer P.<|> pText -- | End-of-line backslash line break. @@ -120,10 +125,164 @@ pLineBreak = do _ <- P.newline return StepBreak +-- | Recipe reference: @./path/to/recipe{quantity} +pRecipeRef :: Parser StepItem +pRecipeRef = do + _ <- P.char '@' + _ <- P.char '.' + _ <- P.char '/' + path <- P.many (P.noneOf "{(\n\\") + mqty <- P.optionMaybe (P.between (P.char '{') (P.char '}') pQuantityBody) + return (StepRecipeRef (RecipeRef path (join mqty))) + +-- | Ingredient: @name{quantity%unit}(preparation) +pIngredient :: Parser StepItem +pIngredient = do + _ <- P.char '@' + (name, qty) <- pNameWithQuantity + prep <- P.optionMaybe (P.try pPreparation) + return (StepIngredient (Ingredient (T.pack name) qty (fmap T.strip prep))) + +{- | Parse a name optionally followed by @{quantity}@ braces. + +Used by ingredients. First tries a multi-word name with braces +(e.g. @sea salt{1%pinch}@), then falls back to a single word. +-} +pNameWithQuantity :: Parser ([Char], Maybe Quantity) +pNameWithQuantity = + P.try + ( do + name <- P.many (P.noneOf "{(\n\\") + _ <- P.char '{' + qty <- pQuantityBody + _ <- P.char '}' + return (name, qty) + ) + P.<|> do + name <- P.many1 (P.alphaNum P.<|> P.oneOf ".-'") + return (name, Nothing) + +{- | Parse a name optionally followed by empty @{}@ braces. + +Used by cookware to delimit multi-word names (@#potato masher{}@). +-} +pNameWithBraces :: Parser [Char] +pNameWithBraces = + P.try + ( do + name <- P.many (P.noneOf "{(\n\\") + _ <- P.char '{' + _ <- P.char '}' + return name + ) + P.<|> P.many1 (P.alphaNum P.<|> P.oneOf ".-'") + +-- | Parse preparation text inside parentheses: @name(diced) +pPreparation :: Parser Text +pPreparation = do + _ <- P.char '(' + content <- P.many (P.noneOf ")") + _ <- P.char ')' + return (T.pack content) + +{- | Parse the body of a @{...}@ quantity block. +Returns 'Nothing' for empty braces @{}@. +-} +pQuantityBody :: Parser (Maybe Quantity) +pQuantityBody = do + content <- P.many (P.noneOf "}") + case content of + [] -> return Nothing -- empty braces + _ -> case parseQuantityText (T.pack content) of + Just q -> return (Just q) + Nothing -> P.parserFail ("invalid quantity: " <> content) + +-- | Parse a quantity text like @2@, @1%kg@, @=1%tsp@, @1\/2%tbsp@. +parseQuantityText :: Text -> Maybe Quantity +parseQuantityText t = + let (fixed, rest) = case T.uncons t of + Just ('=', rest') -> (True, T.strip rest') + _ -> (False, T.strip t) + (amountStr, unit) = case T.break (== '%') rest of + (a, u) | T.null u -> (a, Nothing) + (a, u) -> (a, Just (T.drop 1 u)) + in case parseRational (T.strip amountStr) of + Just a -> Just (Quantity a unit fixed) + Nothing -> Nothing + +-- | Parse a rational number from text. Handles @1\/2@, @3@, @1,1\/2@. +parseRational :: Text -> Maybe Rational +parseRational t = + case T.splitOn "," (T.strip t) of + -- Compound: "1,1/2" → 1 + 1/2 = 3/2 + [a, b] -> (+) <$> parseSimpleRational a <*> parseSimpleRational b + -- Simple: "1/2" or "3" + [a] -> parseSimpleRational a + _ -> Nothing + +-- | Parse a simple rational: @1\/2@, @3@, @0.5@. +parseSimpleRational :: Text -> Maybe Rational +parseSimpleRational t = + case T.splitOn "/" t of + -- Fraction: "1/2" + [num, den] -> + case (readMaybeInt num, readMaybeInt den) of + (Just n, Just d) | d /= 0 -> Just (toRational n / toRational d) + _ -> Nothing + -- Whole or decimal: "3", "0.5" + [a] -> + case readMaybeInt a of + Just n -> Just (toRational n) + Nothing -> case readMaybeDouble a of + Just d -> Just (toRational d) + Nothing -> Nothing + _ -> Nothing + +-- | Try to read a 'Text' as an 'Int'. +readMaybeInt :: Text -> Maybe Int +readMaybeInt t = case reads (T.unpack t) of + [(n, "")] -> Just n + _ -> Nothing + +-- | Try to read a 'Text' as a 'Double'. +readMaybeDouble :: Text -> Maybe Double +readMaybeDouble t = case reads (T.unpack t) of + [(n, "")] -> Just n + _ -> Nothing + +-- | Cookware: #name or #multi word name{} +pCookware :: Parser StepItem +pCookware = P.char '#' *> (StepCookware . Cookware . T.pack <$> pNameWithBraces) + +-- | Timer: ~name{duration%unit} or ~{duration%unit} +pTimer :: Parser StepItem +pTimer = do + _ <- P.char '~' + (name, dur) <- P.try pNamedTimer P.<|> pUnnamedTimer + _ <- P.char '}' + return (StepTimer (Timer (fmap T.pack name) dur)) + where + pNamedTimer = do + n <- P.many1 (P.noneOf "{") + _ <- P.char '{' + d <- pDurationBody + return (Just n, d) + pUnnamedTimer = do + _ <- P.char '{' + d <- pDurationBody + return (Nothing, d) + pDurationBody = do + content <- P.many (P.noneOf "}") + case content of + [] -> P.parserFail "empty timer duration" + _ -> case parseQuantityText (T.pack content) of + Just q -> return (Duration (quantityAmount q) (quantityUnit q)) + Nothing -> P.parserFail ("invalid duration: " <> content) + -- | Plain text (everything up to a special character or newline). pText :: Parser StepItem pText = do - chars <- P.many1 (P.noneOf ['\\', '\n']) + chars <- P.many1 (P.noneOf ['\\', '\n', '@', '#', '~']) return (StepText (T.pack chars)) -- --------------------------------------------------------------------------- diff --git a/test/Roux/ParserSpec.hs b/test/Roux/ParserSpec.hs index 2080afd..1f60db0 100644 --- a/test/Roux/ParserSpec.hs +++ b/test/Roux/ParserSpec.hs @@ -2,7 +2,7 @@ module Roux.ParserSpec (spec) where import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE -import Test.Hspec (Expectation, Spec, describe, expectationFailure, it, shouldBe) +import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe) import Roux.Parser (parseCookFile) import Roux.Types @@ -147,6 +147,118 @@ spec = do } parseCookFile input `shouldBe` expected + describe "Ingredients" $ do + it "parses a simple ingredient with quantity" $ do + let input = "@eggs{3}" + expected = + Right + Recipe + { recipeMetadata = emptyMetadata + , recipeSections = + Section + { sectionName = Nothing + , sectionBody = + SecStep + ( Step + [ StepIngredient + (Ingredient "eggs" (Just (Quantity 3 Nothing False)) Nothing) + ] + ) + :| [] + } + :| [] + } + parseCookFile input `shouldBe` expected + + it "parses an ingredient with quantity and unit" $ do + let input = "@flour{125%g}" + expected = + Right + Recipe + { recipeMetadata = emptyMetadata + , recipeSections = + Section + { sectionName = Nothing + , sectionBody = + SecStep + ( Step + [ StepIngredient + (Ingredient "flour" (Just (Quantity 125 (Just "g") False)) Nothing) + ] + ) + :| [] + } + :| [] + } + parseCookFile input `shouldBe` expected + + it "parses an ingredient without quantity (single word)" $ do + let input = "drizzle of @oil" + expected = + Right + Recipe + { recipeMetadata = emptyMetadata + , recipeSections = + Section + { sectionName = Nothing + , sectionBody = + SecStep + ( Step + [ StepText "drizzle of " + , StepIngredient + (Ingredient "oil" Nothing Nothing) + ] + ) + :| [] + } + :| [] + } + parseCookFile input `shouldBe` expected + + it "parses a multi-word ingredient with empty braces" $ do + let input = "@sea salt{}" + expected = + Right + Recipe + { recipeMetadata = emptyMetadata + , recipeSections = + Section + { sectionName = Nothing + , sectionBody = + SecStep + ( Step + [ StepIngredient + (Ingredient "sea salt" Nothing Nothing) + ] + ) + :| [] + } + :| [] + } + parseCookFile input `shouldBe` expected + + it "parses a multi-word ingredient with quantity and unit" $ do + let input = "@sea salt{1%pinch}" + expected = + Right + Recipe + { recipeMetadata = emptyMetadata + , recipeSections = + Section + { sectionName = Nothing + , sectionBody = + SecStep + ( Step + [ StepIngredient + (Ingredient "sea salt" (Just (Quantity 1 (Just "pinch") False)) Nothing) + ] + ) + :| [] + } + :| [] + } + parseCookFile input `shouldBe` expected + describe "EasyPancakes example" $ do let pancakeInput = "-- TODO add source\n" @@ -180,18 +292,46 @@ spec = do (SecComment t : _) -> t `shouldBe` "TODO add source" other -> expectationFailure ("expected SecComment first, got " <> show other) - it "remaining 6 items are text-only steps" $ do + it "first step parses ingredients correctly" $ do case parseCookFile pancakeInput of Left err -> expectationFailure ("parse failed: " <> err) Right recipe -> do let body = NE.toList (sectionBody (NE.head (recipeSections recipe))) case body of - (_comment : steps) -> mapM_ expectTextStep steps - [] -> expectationFailure "empty body" + (_ : SecStep (Step items) : _) -> do + -- "Crack the @eggs{3} into a blender, then add the @flour{125%g}, @milk{250%ml} and @sea salt{1%pinch}, and blitz until smooth." + let expected = + [ StepText "Crack the " + , StepIngredient (Ingredient "eggs" (Just (Quantity 3 Nothing False)) Nothing) + , StepText " into a blender, then add the " + , StepIngredient (Ingredient "flour" (Just (Quantity 125 (Just "g") False)) Nothing) + , StepText ", " + , StepIngredient (Ingredient "milk" (Just (Quantity 250 (Just "ml") False)) Nothing) + , StepText " and " + , StepIngredient (Ingredient "sea salt" (Just (Quantity 1 (Just "pinch") False)) Nothing) + , StepText ", and blitz until smooth." + ] + items `shouldBe` expected + _ -> + expectationFailure + ("expected SecStep as second body item, got body=" <> show body) --- | Check that a body item is a 'SecStep' containing a single 'StepText'. -expectTextStep :: SectionBodyItem -> Expectation -expectTextStep (SecStep (Step [StepText _])) = pure () -expectTextStep other = - expectationFailure - ("expected SecStep with single StepText, got " <> show other) + it "second step parses cookware and timer" $ do + case parseCookFile pancakeInput of + Left err -> expectationFailure ("parse failed: " <> err) + Right recipe -> do + let body = NE.toList (sectionBody (NE.head (recipeSections recipe))) + case body of + (_ : _ : SecStep (Step items) : _) -> do + -- "Pour into a #bowl and leave to stand for ~{15%minutes}." + let expected = + [ StepText "Pour into a " + , StepCookware (Cookware "bowl") + , StepText " and leave to stand for " + , StepTimer (Timer Nothing (Duration 15 (Just "minutes"))) + , StepText "." + ] + items `shouldBe` expected + _ -> + expectationFailure + ("expected SecStep as third body item, got body=" <> show body)