-- Copyright Isaac Van Doren 2022-present
module Text.Cook (Result(..), Content(..), Category(..), Item(..), Step, Metadata, parseCook) where
import Text.Megaparsec (optional, some, noneOf, many, errorBundlePretty, parse, MonadParsec(try), (<|>), Parsec)
import Text.Megaparsec.Char (hspace, char, string, space, digitChar, newline)
import Data.Void (Void)
import Control.Monad (void, when)
import Text.Printf (printf)
type Parser = Parsec Void String
type Metadata = (String, String)
type Step = [Content]
data Content = Text String
| Ingredient String String String -- label quantity units
| Timer String String String -- label quantity units
| Cookware String String -- label quantity
deriving (Show, Eq)
data Item = Item String String
deriving (Show, Eq)
data Category = Category String [Item]
deriving (Show, Eq)
data Result = Recipe [Metadata] [Step] | Grouping [Category]
deriving (Show, Eq)
-- | Parse a .cook file
parseCook :: String -> Either String Result
parseCook input = case parse cookFile "" (simplify input) of
Left bundle -> Left $ errorBundlePretty bundle
Right result -> Right result
simplify :: String -> String
simplify = inlineComments . blockComments
where
inlineComments = unlines . map f . lines
where
f ('-':'-':_) = ""
f (x:xs) = x : f xs
f "" = ""
blockComments :: String -> String
blockComments ('[':'-':xs) = blockComments (consume xs)
where
consume ('-':']':ys) = ys
consume (_:ys) = consume ys
consume "" = ""
blockComments (x:xs) = x : blockComments xs
blockComments "" = ""
cookFile :: Parser Result
cookFile = grouping <|> recipe
recipe :: Parser Result
recipe = do
pieces <- space *> many (metadata <* space <|> step <* space)
return $ foldr go (Recipe [] []) pieces
where
go (Recipe m s) (Recipe m' s') = Recipe (m ++ m') (s ++ s')
go x y = error $ "Not expecting " ++ show x ++ " and " ++ show y ++ " in recipe parser."
grouping :: Parser Result
grouping = Grouping <$> some (category <* many newline)
category :: Parser Category
category = do
title <- hspace *> char '[' *> some (noneOf "]") <* char ']' <* hspace <* optional newline
items <- many item
return $ Category (norm title) items
item :: Parser Item
item = do
first <- some (noneOf "\n|")
second <- optional (char '|') *> many (noneOf "\n") <* newline
return $ Item (norm first) (norm second)
metadata :: Parser Result
metadata = do
void $ string ">>" <* hspace
key <- some $ noneOf ":"
void $ char ':' <* hspace
value <- some $ word <* hspace
return $ Recipe [(norm key, unwords value)] []
step :: Parser Result
step = do
content <- some $ (ingredient <|> cookware <|> timer <|> text)
return $ Recipe [] [content]
text :: Parser Content
text = Text <$> (some (noneOf "@#~\n"))
ingredient :: Parser Content
ingredient = char '@' *> hspace *>
(try (do
content <- some $ noneOf "#~@\n{"
void $ char '{'
(amount, units) <- quantity
void $ char '}'
return $ Ingredient (norm content) (case amount of "" -> "some"; x -> x) units)
<|> fmap (\x -> Ingredient x "some" "") word)
cookware :: Parser Content
cookware = char '#' *> hspace *>
(try (do
content <- some $ noneOf "#~@\n{"
(amount, _) <- char '{' *> quantity <* char '}'
return $ Cookware (norm content) (case amount of "" -> "1"; x -> x))
<|> fmap (\x -> Cookware x "1") word)
timer :: Parser Content
timer = char '~' *> hspace *>
(try (do
timerLabel <- many $ noneOf "#~@\n{"
void $ char '{'
(amount, units) <- quantity
void $ char '}'
return $ Timer (norm timerLabel) amount units)
<|> fmap (\x -> Timer x "" "") word)
quantity :: Parser (String, String)
quantity = do
amount <- try fraction <|> many (noneOf "\n%}")
void $ hspace *> optional (char '%') <* hspace
units <- many $ noneOf "\n}"
return (norm amount, norm units)
fraction :: Parser String
fraction = do
n1 <- some digitChar <* hspace <* char '/' <* hspace
n2 <- some digitChar
when (all (== '0') n2 || head n1 == '0') (fail "not a vaild fraction")
return $ let x = printf "%.2f" ((read n1 / read n2) :: Double)
in if last x == '0' then init x else x
word :: Parser String
word = some $ noneOf " \t\n"
-- removes extra whitespace
norm :: String -> String
norm = unwords . words