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
2026-05-19 12:58:43 -04:00
parent 1e150e703e
commit c55a54796a
7 changed files with 133 additions and 25 deletions
@@ -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 <recipe-directory>"
+    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)
@@ -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:
@@ -0,0 +1 @@
+/work/personal/roux/personal-recipes
@@ -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:
@@ -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
 -- ---------------------------------------------------------------------------
@@ -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)
@@ -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