roux/src/Roux/Parser.hs

{- | Parser for Cooklang (.cook) recipe files.

Parses the full file structure: full-line comments, notes, section headers,
and steps.  Inline element parsing (ingredients, cookware, timers, …) is
added incrementally in follow-up commits.
-}
module Roux.Parser (
    parseCookFile,
) where

import Control.Monad (join)
import Data.Char (isDigit)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Parsec as P
import Text.Parsec.Text (Parser)

import Roux.Types

-- ---------------------------------------------------------------------------
-- Internal raw-block types (parser only)
-- ---------------------------------------------------------------------------

{- | The result of classifying a top-level block before building the final
'SectionBodyItem' tree.
-}
data RawBlock
    = RawStep !Step
    | RawComment !Text
    | RawNote !Text
    | RawSectionHeader !Text
    deriving stock (Eq, Show)

-- ---------------------------------------------------------------------------
-- Entry point
-- ---------------------------------------------------------------------------

-- | Parse a complete @.cook@ file into a 'Recipe'.
parseCookFile :: Text -> Either String Recipe
parseCookFile input =
    let trimmed = T.strip input
        rawBlocks = splitByBlankLines trimmed
        nonEmpty = filter (not . T.null) rawBlocks
     in case nonEmpty of
            [] ->
                Right emptyRecipe
            blocks ->
                case traverse classifyBlock blocks of
                    Left err -> Left err
                    Right items -> Right (buildRecipe items)

-- ---------------------------------------------------------------------------
-- File-level structure
-- ---------------------------------------------------------------------------

{- | Split text into blocks separated by one or more blank lines,
preserving each block's internal newlines.
-}
splitByBlankLines :: Text -> [Text]
splitByBlankLines = map T.strip . T.splitOn "\n\n"

-- | Classify a single top-level block.
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)))
    | Just name <- stripSectionHeader trimmed =
        Right (RawSectionHeader name)
    | otherwise =
        case P.parse (pStepBlock <* P.eof) "" trimmed of
            Left err -> Left (show err)
            Right step -> Right (RawStep step)
  where
    trimmed = T.strip block

{- | Try to extract a section name from header markup.

Recognises @= Name =@, @=  Name@, @== Name ==@, etc.  One or more @=@
signs on each side, with optional whitespace inside.
-}
stripSectionHeader :: Text -> Maybe Text
stripSectionHeader t =
    let stripped = T.strip t
     in case T.break (/= '=') stripped of
            -- At least one leading =
            (leadingEq, afterEq)
                | not (T.null leadingEq) ->
                    let afterSpace = T.strip afterEq
                     in case T.break (== '=') afterSpace of
                            -- No trailing = signs -> the whole thing is the name
                            (name, trailingEqs)
                                | T.all (== '=') (T.strip trailingEqs)
                                , not (T.null (T.strip name)) ->
                                    Just (T.strip name)
                            _ -> Nothing
            _ -> Nothing

-- ---------------------------------------------------------------------------
-- Step-level parser (Parsec)
-- ---------------------------------------------------------------------------

-- | Parse a single step block.
pStepBlock :: Parser Step
pStepBlock = do
    items <- P.many pStepItem
    return (Step items)

-- | Parse one inline item within a step.
pStepItem :: Parser StepItem
pStepItem =
    pLineBreak
        P.<|> P.try pInlineComment
        P.<|> P.try pEndComment
        P.<|> P.try pRecipeRef
        P.<|> P.try pIngredient
        P.<|> P.try pCookware
        P.<|> P.try pTimer
        P.<|> pText

-- | End-of-line backslash line break.
pLineBreak :: Parser StepItem
pLineBreak = do
    _ <- P.char '\\'
    P.optional (P.char '\r')
    _ <- P.newline
    return StepBreak

-- | Characters allowed in recipe reference paths.
pPathChar :: Parser Char
pPathChar = P.alphaNum P.<|> P.oneOf "./-_"

-- | Recipe reference: @./path/to/recipe{quantity}
pRecipeRef :: Parser StepItem
pRecipeRef = do
    _ <- P.char '@'
    -- Consume @ and store ./ as part of the path
    _ <- P.char '.'
    _ <- P.char '/'
    path <- P.many pPathChar
    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)))

-- | Characters allowed in names that may include spaces (before braces).
pMultiNameChar :: Parser Char
pMultiNameChar = P.alphaNum P.<|> P.oneOf " .-'"

-- | Characters allowed in single-word names (no braces).
pSingleNameChar :: Parser Char
pSingleNameChar = P.alphaNum P.<|> P.oneOf ".-'"

{- | 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 pMultiNameChar
            _ <- P.char '{'
            qty <- pQuantityBody
            _ <- P.char '}'
            return (name, qty)
        )
        P.<|> do
            name <- P.many1 pSingleNameChar
            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 pMultiNameChar
            _ <- P.char '{'
            _ <- P.char '}'
            return name
        )
        P.<|> P.many1 pSingleNameChar

-- | 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@, or
@1,1\/2cups@ (unit without @%@ separator).
-}
parseQuantityText :: Text -> Maybe Quantity
parseQuantityText t =
    let (fixed, rest) = case T.uncons t of
            Just ('=', rest') -> (True, T.strip rest')
            _ -> (False, T.strip t)
        (amountPart, unitPart) = case T.break (== '%') rest of
            (a, u)
                | T.null u -> splitAmountUnit a
                | otherwise -> (a, Just (T.strip (T.drop 1 u)))
     in case parseRational (T.strip amountPart) of
            Just a -> Just (Quantity a unitPart fixed)
            Nothing -> Nothing

{- | Split text into amount and optional trailing unit (no @%@ separator).
Handles @"1,1\/2cups"@ → @("1,1\/2", Just "cups")@.
-}
splitAmountUnit :: Text -> (Text, Maybe Text)
splitAmountUnit t =
    let (numeric, trailing) = T.span isNumericChar t
     in if T.null trailing
            then (numeric, Nothing)
            else (numeric, Just (T.strip trailing))

-- | Characters that can appear in a quantity number.
isNumericChar :: Char -> Bool
isNumericChar c = isDigit c || c `elem` ['.', ',', '/', ' ', '-', '+']

-- | 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

-- | Inline block comment: [- comment text -]
pInlineComment :: Parser StepItem
pInlineComment = do
    _ <- P.string "[-"
    content <- P.manyTill P.anyChar (P.try (P.string "-]"))
    return (StepComment (T.pack content))

-- | End-of-line comment: -- rest of line
pEndComment :: Parser StepItem
pEndComment = do
    _ <- P.string "--"
    content <- P.many (P.noneOf "\n")
    return (StepEndComment (T.strip (T.pack content)))

-- | 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, newline, or comment start).
pText :: Parser StepItem
pText = do
    chars <- P.many1 (P.notFollowedBy (P.string "--") *> P.notFollowedBy (P.string "[-") *> P.noneOf ['\\', '\n', '@', '#', '~'])
    return (StepText (T.pack chars))

-- ---------------------------------------------------------------------------
-- Recipe construction
-- ---------------------------------------------------------------------------

{- | Build a 'Recipe' from classified blocks, grouping into sections at
'RawSectionHeader' boundaries.
-}
buildRecipe :: [RawBlock] -> Recipe
buildRecipe items =
    case sections of
        [] -> emptyRecipe
        (s : ss) ->
            Recipe
                { recipeMetadata = emptyMetadata
                , recipeSections = s :| ss
                }
  where
    sections = groupSections items

{- | Group a flat list of 'RawBlock' values into sections, splitting at
'RawSectionHeader' boundaries.
-}
groupSections :: [RawBlock] -> [Section]
groupSections [] = []
groupSections items =
    case span (not . isSectionHeader) items of
        -- No section header: everything goes into an unnamed section
        (body, []) ->
            [Section Nothing (makeNonEmpty (map rawToBody body))]
        -- Items before the first header → unnamed section, then named
        (before, (RawSectionHeader name) : rest) ->
            let pre =
                    if null before
                        then []
                        else [Section Nothing (makeNonEmpty (map rawToBody before))]
                named = collectNamedSection name rest
             in pre ++ named
        -- Unreachable: 'span' never returns a non-header as the first item
        -- of the second component, but GHC doesn't know that.
        _ -> error "groupSections: impossible"

-- | Is this block a section header?
isSectionHeader :: RawBlock -> Bool
isSectionHeader (RawSectionHeader _) = True
isSectionHeader _ = False

-- | Collect a named section: from the header to the next header (or end).
collectNamedSection :: Text -> [RawBlock] -> [Section]
collectNamedSection name items =
    case span (not . isSectionHeader) items of
        (body, []) ->
            [Section (Just name) (makeNonEmpty (map rawToBody body))]
        (body, (RawSectionHeader nextName) : rest) ->
            Section (Just name) (makeNonEmpty (map rawToBody body))
                : collectNamedSection nextName rest
        _ -> error "collectNamedSection: impossible"

-- | Convert a 'RawBlock' to a 'SectionBodyItem'.
rawToBody :: RawBlock -> SectionBodyItem
rawToBody (RawStep s) = SecStep s
rawToBody (RawComment t) = SecComment t
rawToBody (RawNote t) = SecNote t
rawToBody (RawSectionHeader _) = error "rawToBody: section header should not appear here"

-- | Convert a list to 'NonEmpty', using a single empty step as default.
makeNonEmpty :: [SectionBodyItem] -> NonEmpty SectionBodyItem
makeNonEmpty [] = SecStep (Step []) :| []
makeNonEmpty (x : xs) = x :| xs

-- | An empty recipe (no metadata, one unnamed section with one empty step).
emptyRecipe :: Recipe
emptyRecipe =
    Recipe
        { recipeMetadata = emptyMetadata
        , recipeSections = Section Nothing (SecStep (Step []) :| []) :| []
        }