nymphaea-0.1: src/Parser.hs

module Parser (parseLSystem, ParsedLSystem (ParsedLS), axiom, productions) where

import Text.ParserCombinators.Parsec
import Data.Ratio
-- import Debug.Trace

data ParsedLSystem = ParsedLS { axiom :: [(String, Rational)],
                                productions :: [(Char,[(String,Rational)])] }

parseLSystem :: String -> String -> Either ParseError ParsedLSystem
parseLSystem axm prductions =
    case parse prods "productions" prductions of
        Left err -> Left err
        Right ps -> case parse rvalue "axiom" axm of
                            Left err -> Left err
                            Right a -> Right (ParsedLS a ps)

-- Example:
--
-- Char {
--   Probability String,
--   ...,
--   Probability String
-- };
-- Char { ... }

-- a ruleset is a set of ';'-separated rules
prods :: GenParser Char st [(Char, [([Char], Rational)])]
prods = semicolonSep production

-- a single production is of the form x -> y where x is a turtle graphics command
-- and y is a string of commands, or a weighted set of them.
production :: GenParser Char st (Char, [([Char], Rational)])
production = do
    from <- lvalue
    symbol "->"
    to <- rvalue
    return (from,to)
  <?> "production"

-- alphabet
alphabet :: [Char]
alphabet = "FG+-[]"

-- the "Char" in "Char { Probability String, .. }"
lvalue :: CharParser st Char
lvalue = oneOf alphabet

-- either a weighted set of productions, or a single production
rvalue :: GenParser Char st [([Char], Rational)]
rvalue = weightedSet turtle <|> fmap (\x -> [(x,1)]) turtle

weightedSet :: GenParser Char st t -> GenParser Char st [(t, Rational)]
weightedSet p =
    inCurlyBraces $ commaSep $ do
        prob <- probability
        symbol ":"
        to <- p
        return (to, prob)

turtle :: GenParser Char st [Char]
turtle = between spaces spaces $ many1 (oneOf alphabet)

-- Probability could be a decimal (0.5) or a rational (1/2)
probability :: GenParser Char st Rational
probability = (try decimal) <|> rational <?> "probability"
  where decimal = do a <- many1 digit
                     char '.'
                     b <- many digit
                     return $ approxRational (read $ (a ++ "." ++ b) :: Double) 10^(- length b)
        rational = do a <- many1 digit
                      b <- (do char '/'; many1 digit) <|> return "1"
                      return $ read (a ++ "%" ++ b)

symbol :: String -> GenParser Char st String
symbol s = between spaces spaces (string s)

semicolonSep :: GenParser Char st a -> GenParser Char st [a]
semicolonSep p = p `sepBy` symbol ";"

commaSep :: GenParser Char st a -> GenParser Char st [a]
commaSep p = p `sepBy` symbol ","

inCurlyBraces :: GenParser Char st a -> GenParser Char st a
inCurlyBraces p = between (symbol "{") (symbol "}") p