module Isotope.Parsers (
elementSymbol
, subFormula
, molecularFormula
, condensedFormula
, mol
, emp
, con
) where
import Isotope.Base
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Lift
import Text.Megaparsec
import Text.Megaparsec.String
import qualified Text.Megaparsec.Lexer as L
import Data.String
import Data.List hiding (filter)
import Data.Map (Map)
elementSymbol :: Parser ElementSymbol
elementSymbol = read <$> choice (try . string <$> elementSymbolStrList)
where elementList = show <$> elementSymbolList
reverseLengthSort x y = length y `compare` length x
elementSymbolStrList = sortBy reverseLengthSort elementList
subFormula :: Parser MolecularFormula
subFormula = do
sym <- elementSymbol
num <- optional L.integer
return $ case num of
Nothing -> mkMolecularFormula [(sym, 1)]
Just num' -> mkMolecularFormula [(sym, fromIntegral num')]
molecularFormula :: Parser MolecularFormula
molecularFormula = do
formulas <- many subFormula
return $ mconcat formulas
parenFormula :: Parser (Either MolecularFormula ([MolecularFormula], Int))
parenFormula = do
_ <- char '('
formula <- some subFormula
_ <- char ')'
num <- optional L.integer
return $ Right $ case num of
Nothing -> (formula, 1)
Just num' -> (formula, fromIntegral num')
leftMolecularFormula :: Parser (Either MolecularFormula ([MolecularFormula], Int))
leftMolecularFormula = do
formula <- subFormula
return $ Left formula
condensedFormula :: Parser CondensedFormula
condensedFormula = do
result <- many (leftMolecularFormula <|> parenFormula)
return $ CondensedFormula result
quoteMolecularFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $ "Could not parse formula: " ++ show err
Right v -> lift $ toMolecularFormula v
quoteEmpiricalFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $ "Could not parse formula: " ++ show err
Right v -> lift $ toEmpiricalFormula v
quoteCondensedFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> error $ "Could not parse formula: " ++ show err
Right v -> lift v
mol :: QuasiQuoter
mol = QuasiQuoter
{ quoteExp = quoteMolecularFormula }
emp :: QuasiQuoter
emp = QuasiQuoter
{ quoteExp = quoteEmpiricalFormula }
con :: QuasiQuoter
con = QuasiQuoter
{ quoteExp = quoteCondensedFormula }
$(deriveLift ''MolecularFormula)
$(deriveLift ''EmpiricalFormula)
$(deriveLift ''CondensedFormula)
$(deriveLift ''Map)
$(deriveLift ''ElementSymbol)