sifflet-lib-1.0: Sifflet/Language/Parser.hs
-- | A parser for Sifflet input values.
-- This is not a parser for all Sifflet expressions,
-- but just those that might be input in textual form
-- through the function call dialog that asks for the argument values.
-- So, it is limited (deliberately) to "data" types of expressions:
-- that is, Exprs using the constructors:
-- ELit
-- EList
-- That means excluding Exprs constructed with EUndefined,
-- ESymbol, EIf, and ECall.
module Sifflet.Language.Parser
(parseExpr, parseInput
-- , parseInputAsValue
, parseTest
, parseSuccFail, nothingBut
, expr, list, literal
, value, typedValue
, bool, qchar, qstring, integer, double
, number
)
where
import Text.ParserCombinators.Parsec
import Sifflet.Language.Expr
import Sifflet.Util
-- | Parse a Sifflet data literal (number, string, char, bool, or list)
parseExpr :: String -> SuccFail Expr
parseExpr = parseSuccFail expr
-- | Parse a Sifflet input containing exactly one data expression
-- possibly flanked by white space
parseInput :: String -> SuccFail Expr
parseInput = parseSuccFail input
parseSuccFail :: Parser a -> String -> SuccFail a
parseSuccFail p s =
case parse p "user input" s of
Left perr -> Fail (show perr)
Right v -> Succ v
-- | Like expr, but consumes the entire input,
-- so there must not be any extraneous characters after the Expr.
input :: Parser Expr
input = nothingBut expr
-- | 'nothingBut p is like 'p', but consumes the entire input,
-- so there must be no extraneous characters (except space)
-- after whatever 'p' parses.
nothingBut :: Parser a -> Parser a
nothingBut p = (many space >> p) `prog1` (many space >> eof)
prog1 :: (Monad m) => m a -> m b -> m a
prog1 m1 m2 = m1 >>= (\ r -> m2 >> return r)
-- | Parse a Sifflet data expression
expr :: Parser Expr
expr = -- (try (list expr >>= return . EList)) <|>
literal
list :: Parser a -> Parser [a]
list element =
let sep = try (skipMany space >> char ',' >> skipMany space)
in (char '[' >> many space >> sepBy element sep)
`prog1`
(many space >> char ']')
-- do I need (...) above?
<?> "list" -- ???
literal :: Parser Expr
literal = value >>= return . ELit
-- | Parser for a Value of any type (any VpType),
-- except that we cannot parse as VpTypeVar or VpTypeFunction.
value :: Parser Value
value = (bool >>= return . VBool) <|>
(qchar >>= return .VChar) <|>
(qstring >>= return . VStr) <|>
try (double >>= return . VFloat) <|>
(integer >>= return . VInt) <|>
(list value >>= return . VList)
-- | Parser for a value with a specific VpType expected.
-- Again, we cannot do this for VpTypeVar (why not?)
-- or VpTypeFunctiopn
typedValue :: VpType -> Parser Value
typedValue t =
(case t of
VpTypeBool -> bool >>= return . VBool
VpTypeChar -> qchar >>= return . VChar
VpTypeString -> qstring >>= return . VStr
VpTypeNum -> do { en <- number;
case en of
Left x -> return (VFloat x)
Right i -> return (VInt i)
}
VpTypeList e -> list (typedValue e) >>= return . VList
VpTypeVar _ -> value -- can't check, so just accept anything
VpTypeFunction _ _ ->
error "typedValue: not implemented for VpTypeFunction"
)
<?> typeName t
-- | A name for the type, for use in parser error reporting
typeName :: VpType -> String
typeName t =
case t of
VpTypeBool -> "boolean" -- "boolean (True or False)"
VpTypeChar -> "character" -- "character (in single quotes)"
VpTypeNum -> "number"
VpTypeString -> "string" -- "string (in double quotes)"
VpTypeList e -> "list" ++ -- "list (in brackets)" ++
case e of
VpTypeVar _ -> ""
_ -> " of " ++ typeName e
VpTypeVar _ -> "anything" -- could be more specific!
VpTypeFunction _ _ -> "function" -- ???
bool :: Parser Bool
bool = (try (string "True" >> return True) <|>
(string "False" >> return False))
<?> typeName VpTypeBool
-- quoted character 'c'
qchar :: Parser Char
qchar =
let sq = '\'' -- single quote character
in (((char sq <?> "opening single quote") >>
(try escapedChar <|> noneOf [sq]))
`prog1`
(char sq <?> "closing single quote")
)
<?> typeName VpTypeChar
-- quoted string "c..."
qstring :: Parser String
qstring =
let dq = '\"' -- double quote character
in (char dq >>
many (escapedChar <|> noneOf [dq] <?> ""))
`prog1`
(char dq <?> "close of quotation")
-- Do I need (...) above?
<?> typeName VpTypeString
-- escapedChar recognizes the following escape sequences:
-- \t = tab
-- \n = newline
-- \r = carriage return
-- \\ = backslash
-- Anything else that begins with \ is an error.
escapedChar :: Parser Char
escapedChar =
let bs = '\\' -- backslash character
in char bs >>
(oneOf "ntr\\" <?> "n, t, r, or \\ to follow \\") >>=
(\ c ->
return (case c of
'n' -> '\n'
't' -> '\t'
'r' -> '\r'
'\\' -> '\\'
_ -> error "escapedChar: c MUST be n, t, r, or \\"
)
)
-- do { _ <- char bs;
-- c <- oneOf "ntr\\"
-- <?>
-- "n, t, r, or \\ to follow \\";
-- return (case c of
-- 'n' -> '\n'
-- 't' -> '\t'
-- 'r' -> '\r'
-- '\\' -> '\\'
-- _ -> error "escapedChar: c MUST be n, t, r, or \\"
-- )
-- }
data Sign = Minus | Plus
-- Integer ::= (+|-)? digit+
integer :: Parser Integer -- sign, digits
integer = do { s <- optSign;
u <- unsignedInteger;
return (applySign s u)
}
<?> "integer"
unsignedInteger :: Parser Integer
unsignedInteger = many1 digit >>= return . read
-- An optional + or - defaulting to +
optSign :: Parser Sign -- 1: negative; 0: non-negative
optSign = try ( char '-' >> return Minus ) <|>
try ( char '+' >> return Plus ) <|>
return Plus
applySign :: (Num n) => Sign -> n -> n
applySign s x =
case s of
Minus -> (- x)
Plus -> x
-- A double (float) may begin with a sign (+ or -) and must contain
-- a decimal point along with at least one digit before and/or after
-- the decimal point.
-- So there are three cases:
-- [sign] digits '.' digits
-- [sign] digits '.'
-- [sign] '.' digits
double :: Parser Double
-- Double FAILS if there is a decimal point.
-- It succeeds in the following cases:
double =
let digits1 = many1 digit
point = char '.'
-- wpf: whole-part point fraction-part
wpf = do { dd <- digits1;
dd' <- point >> digits1;
return (dd, dd')
}
-- wp: whole-part point
wp = do { dd <- digits1 `prog1` point;
return (dd, "0")
}
-- pf: point fraction-part
pf = do { dd' <- point >> digits1;
return ("0", dd')
}
-- optional trailing exponent notation e.g. e-4
scale = do { i <- oneOf "eE" >> integer;
return (10 ** fromIntegral i)
}
<|> return 1
in do { sign <- optSign
; (whole, frac) <- (try wpf <|>
try wp <|>
try pf)
; m <- scale;
; let w = read (whole ++ ".0") -- whole part as number
f = read ("0." ++ frac) -- frac part as number
; return (m * applySign sign (w + f))
}
<?> "real number"
-- A number may be either a double (with decimal point) or an integer (without).
-- To avoid consuming "123" from "123." and interpreting it as an integer,
-- we MUST try to parse double before integer.
number :: Parser (Either Double Integer)
number = (try (double >>= return . Left) <|>
(integer >>= return . Right))
<?> typeName VpTypeNum
-- -- numberValue :: Parser Value
-- -- numberValue = do { x <- number;
-- -- case x of
-- -- value :: Parser Value
-- value = (bool >>= return . VBool) <|>
-- (qchar >>= return . VChar)
-- Left dx -> return (VFloat dx)
-- -- Right ix -> return (VInt ix)
-- -- }
-- -- <?> typeName VpTypeNumber