From c55a54796a48ec0ba81f0b5662daf2b6459f9c46 Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Tue, 19 May 2026 12:58:43 -0400 Subject: [PATCH] Fix parser for personal recipes: newlines, ranges, &, markdown-style headings Three categories of fixes: 1. Multi-line steps: removed \n from pText exclusion list so newlines within a step are consumed as regular text 2. Range timers (e.g. ~{14-18%minutes}): handle hyphen-separated ranges in parseSimpleRational by taking the lower value 3. & in ingredient names: added & to pSingleNameChar and pMultiNameChar char sets 4. Markdown-style # headings: added pAnyChar fallback so # followed by invalid cookware name falls through to text consumption 5. Note detection: tightened > check to require > (with space) or > followed by non->, preventing >> metadata from being treated as notes --- app/check-recipes/Main.hs | 31 +++++++++++++++++++++++++++++++ package.yaml | 8 ++++++++ personal-recipes | 1 + roux-server.cabal | 32 ++++++++++++++++++++++++++++++++ src/Roux/Parser.hs | 37 ++++++++++++++++++++++++++----------- test-parse.hs | 27 +++++++++++++++++++++++++++ test/Roux/ParserSpec.hs | 22 ++++++++-------------- 7 files changed, 133 insertions(+), 25 deletions(-) create mode 100644 app/check-recipes/Main.hs create mode 120000 personal-recipes create mode 100644 test-parse.hs diff --git a/app/check-recipes/Main.hs b/app/check-recipes/Main.hs new file mode 100644 index 0000000..2b57b46 --- /dev/null +++ b/app/check-recipes/Main.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import System.Directory (listDirectory) +import System.Environment (getArgs) +import System.FilePath (takeExtension, ()) +import qualified Data.Text.IO as TIO +import Roux.Parser (parseCookFile) + +main :: IO () +main = do + args <- getArgs + let recipeDir = case args of + (d : _) -> d + [] -> error "Usage: check-recipes " + entries <- listDirectory recipeDir + let cookFiles = filter ((== ".cook") . takeExtension) (map (recipeDir ) entries) + putStrLn $ "Found " ++ show (length cookFiles) ++ " recipes in " ++ recipeDir + results <- mapM testParse cookFiles + let failures = [(name, err) | (name, Just err) <- results] + ok = length results - length failures + mapM_ (\(name, err) -> putStrLn $ "\n" ++ name ++ ":\n " ++ err) failures + putStrLn $ "\nOK: " ++ show ok ++ " / FAIL: " ++ show (length failures) + where + testParse fp = do + let name = reverse . takeWhile (/= '/') . reverse $ fp + content <- TIO.readFile fp + case parseCookFile content of + Left err -> pure (name, Just err) + Right _ -> pure (name, Nothing) diff --git a/package.yaml b/package.yaml index bb31acf..2d44284 100644 --- a/package.yaml +++ b/package.yaml @@ -57,6 +57,14 @@ executables: - optparse-applicative - roux-server - unix + check-recipes: + main: Main.hs + source-dirs: app/check-recipes + dependencies: + - directory + - filepath + - roux-server + - text tests: roux-server-test: diff --git a/personal-recipes b/personal-recipes new file mode 120000 index 0000000..be6fc33 --- /dev/null +++ b/personal-recipes @@ -0,0 +1 @@ +/work/personal/roux/personal-recipes \ No newline at end of file diff --git a/roux-server.cabal b/roux-server.cabal index edda97e..53bd139 100644 --- a/roux-server.cabal +++ b/roux-server.cabal @@ -51,6 +51,38 @@ library , warp default-language: Haskell2010 +executable check-recipes + main-is: Main.hs + other-modules: + Paths_roux_server + autogen-modules: + Paths_roux_server + hs-source-dirs: + app/check-recipes + default-extensions: + DerivingStrategies + LambdaCase + OverloadedStrings + TupleSections + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , blaze-html + , blaze-markup + , bytestring + , containers + , directory + , filepath + , http-types + , optparse-applicative + , parsec + , roux-server + , text + , time + , wai + , warp + default-language: Haskell2010 + executable roux-server main-is: Main.hs other-modules: diff --git a/src/Roux/Parser.hs b/src/Roux/Parser.hs index fc5f8ea..4554f90 100644 --- a/src/Roux/Parser.hs +++ b/src/Roux/Parser.hs @@ -146,8 +146,11 @@ classifyBlock :: Text -> Either String RawBlock classifyBlock block | "--" `T.isPrefixOf` trimmed = Right (RawComment (T.strip (T.drop 2 trimmed))) - | ">" `T.isPrefixOf` trimmed = - Right (RawNote (T.strip (T.drop 1 trimmed))) + | T.isPrefixOf "> " trimmed = + Right (RawNote (T.strip (T.drop 2 trimmed))) + | Just rest <- T.stripPrefix ">" trimmed + , not (T.isPrefixOf ">" rest) = + Right (RawNote (T.strip rest)) | Just name <- stripSectionHeader trimmed = Right (RawSectionHeader name) | otherwise = @@ -200,6 +203,7 @@ pStepItem = P.<|> P.try pCookware P.<|> P.try pTimer P.<|> pText + P.<|> pAnyChar -- | End-of-line backslash line break. pLineBreak :: Parser StepItem @@ -234,11 +238,11 @@ pIngredient = do -- | Characters allowed in names that may include spaces (before braces). pMultiNameChar :: Parser Char -pMultiNameChar = P.alphaNum P.<|> P.oneOf " .-'" +pMultiNameChar = P.alphaNum P.<|> P.oneOf " .-'&" -- | Characters allowed in single-word names (no braces). pSingleNameChar :: Parser Char -pSingleNameChar = P.alphaNum P.<|> P.oneOf ".-'" +pSingleNameChar = P.alphaNum P.<|> P.oneOf ".-'&" {- | Parse a name optionally followed by @{quantity}@ braces. @@ -343,13 +347,20 @@ parseSimpleRational t = case (readMaybeInt num, readMaybeInt den) of (Just n, Just d) | d /= 0 -> Just (toRational n / toRational d) _ -> Nothing - -- Whole or decimal: "3", "0.5" + -- Range or whole/decimal: "14-18" or "3" or "0.5" [a] -> - case readMaybeInt a of - Just n -> Just (toRational n) - Nothing -> case readMaybeDouble a of - Just d -> Just (toRational d) - Nothing -> Nothing + -- Handle range "14-18" -> use the lower value + case T.splitOn "-" a of + [first, _rest] -> + case readMaybeInt (T.strip first) of + Just n -> Just (toRational n) + Nothing -> Nothing + _ -> + 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'. @@ -410,9 +421,13 @@ pTimer = do -- | Plain text (everything up to a special character, newline, or comment start). pText :: Parser StepItem pText = do - chars <- P.many1 (P.notFollowedBy (P.string "--") *> P.notFollowedBy (P.string "[-") *> P.noneOf ['\\', '\n', '@', '#', '~']) + chars <- P.many1 (P.notFollowedBy (P.string "--") *> P.notFollowedBy (P.string "[-") *> P.noneOf ['\\', '@', '#', '~']) return (StepText (T.pack chars)) +-- | Fallback: consume any single character as plain text. +pAnyChar :: Parser StepItem +pAnyChar = StepText . T.singleton <$> P.anyChar + -- --------------------------------------------------------------------------- -- Recipe construction -- --------------------------------------------------------------------------- diff --git a/test-parse.hs b/test-parse.hs new file mode 100644 index 0000000..0862595 --- /dev/null +++ b/test-parse.hs @@ -0,0 +1,27 @@ +module Main where + +import System.Directory (listDirectory) +import System.FilePath (takeExtension) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Roux.Parser (parseCookFile) + +main :: IO () +main = do + entries <- listDirectory "/work/personal-recipes" + let cookFiles = filter ((== ".cook") . takeExtension) (map ("/work/personal-recipes/" ++) entries) + results <- mapM testParse cookFiles + let failures = [(name, err) | Right (name, err) <- results] + successes = length [() | Left name <- results] + putStrLn $ "\n=== Summary ===" + putStrLn $ "Total: " ++ show (length results) + putStrLn $ "OK: " ++ show successes + putStrLn $ "Failures: " ++ show (length failures) + mapM_ (\(name, err) -> putStrLn $ "\n " ++ name ++ ":\n " ++ err) failures + where + testParse fp = do + let name = reverse . takeWhile (/= '/') . reverse $ fp + content <- TIO.readFile fp + case parseCookFile content of + Left err -> pure (Right (name, err)) + Right _ -> pure (Left name) diff --git a/test/Roux/ParserSpec.hs b/test/Roux/ParserSpec.hs index a3e34fe..752070c 100644 --- a/test/Roux/ParserSpec.hs +++ b/test/Roux/ParserSpec.hs @@ -335,7 +335,6 @@ spec = do let body = NE.toList (sectionBody (NE.head (recipeSections recipe))) case body of (_ : 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) @@ -348,9 +347,7 @@ spec = do , StepText ", and blitz until smooth." ] items `shouldBe` expected - _ -> - expectationFailure - ("expected SecStep as second body item, got body=" <> show body) + _ -> expectationFailure ("expected SecStep as second body item, got body=" <> show body) it "second step parses cookware and timer" $ do case parseCookFile pancakeInput of @@ -359,7 +356,6 @@ spec = 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") @@ -368,9 +364,7 @@ spec = do , StepText "." ] items `shouldBe` expected - _ -> - expectationFailure - ("expected SecStep as third body item, got body=" <> show body) + _ -> expectationFailure ("expected SecStep as third body item, got body=" <> show body) describe "Quantities" $ do it "parses compound quantity (1,1/2) with unit attached" $ do @@ -379,9 +373,9 @@ spec = do Left err -> expectationFailure ("parse failed: " <> err) Right recipe -> do let items = stepItems recipe - items - `shouldBe` [ StepIngredient (Ingredient "water" (Just (Quantity (3 % 2) (Just "cups") False)) Nothing) - ] + items `shouldBe` + [ StepIngredient (Ingredient "water" (Just (Quantity (3 % 2) (Just "cups") False)) Nothing) + ] it "parses quantity with trailing unit (no %)" $ do let input = "@gelatine{3tsp}" @@ -389,9 +383,9 @@ spec = do Left err -> expectationFailure ("parse failed: " <> err) Right recipe -> do let items = stepItems recipe - items - `shouldBe` [ StepIngredient (Ingredient "gelatine" (Just (Quantity 3 (Just "tsp") False)) Nothing) - ] + items `shouldBe` + [ StepIngredient (Ingredient "gelatine" (Just (Quantity 3 (Just "tsp") False)) Nothing) + ] describe "Recipe references" $ do it "parses a recipe reference" $ do