module Data.Quantities.DefinitionParser where
import Control.Applicative ((<$>), (<*))
import System.Environment
import Text.ParserCombinators.Parsec
import Data.Quantities.Data (Definition (..), Symbol, units, magnitude)
import Data.Quantities.ExprParser (parseExpr)
main :: IO ()
main = do
defs <- readDefinitions <$> head <$> getArgs
print defs
readDefinitions :: String -> [Definition]
readDefinitions input = case parse readDefinitions' "Input File Parser" input of
Left err -> error (show err) >> []
Right val -> val
readDefinitions' :: Parser [Definition]
readDefinitions' = many parseDef <* eof
parseDef :: Parser Definition
parseDef = do
_ <- spaces
optional $ many $ char '\n'
line <- try parseDefLine <|> try parseBaseLine <|> parsePrefixLine
spaces
optional $ many $ char '\n'
return line
eol :: Parser Char
eol = char '\n'
parseDefLine :: Parser Definition
parseDefLine = do
(UnitDefinition s e []) <- parseUnitDef
syns <- many (try parseSynonym)
return $ UnitDefinition s e syns
parseUnitDef :: Parser Definition
parseUnitDef = do
sym <- parseSymbol <* spaces <* char '='
quant <- parseExpr
spaces
return $ UnitDefinition sym quant []
parseSynonym :: Parser Symbol
parseSynonym = spaces >> char '=' >> spaces >> parseSymbol <* spaces
parseBaseLine :: Parser Definition
parseBaseLine = do
(sym, f) <- parseBase
syns <- many (try parseSynonym)
return $ BaseDefinition sym f syns
parseBase :: Parser (Symbol, Symbol)
parseBase = do
sym <- parseSymbol <* spaces <* char '='
b <- spaces >> char '[' >> option "" parseSymbol <* char ']'
spaces
return (sym, b)
parsePrefixLine :: Parser Definition
parsePrefixLine = do
(p, f) <- parsePrefix
syns <- many (try parsePrefixSynonym)
return $ PrefixDefinition p f syns
parsePrefix :: Parser (Symbol, Double)
parsePrefix = do
pre <- many1 letter <* char '-' <* spaces <* char '='
facQuant <- spaces >> parseExpr
spaces
if null (units facQuant) then
return (pre, magnitude facQuant)
else fail "No units allowed in prefix definitions"
parsePrefixSynonym :: Parser Symbol
parsePrefixSynonym = spaces >> char '=' >> spaces >> parseSymbol <* char '-' <* spaces
parseSymbol :: Parser Symbol
parseSymbol = do
letter' <- letter
rest <- many (alphaNum <|> char '_')
return $ letter' : rest