module Isotope.Parsers (
elementSymbol
, subFormula
, elementalComposition
, molecularFormula
, condensedFormula
, empiricalFormula
, ele
, mol
, con
, emp
) 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)
import Data.Monoid ((<>))
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 (ElementSymbol, Int)
subFormula =
(\sym num -> (sym, fromIntegral num)) <$> elementSymbol <*> option 1 L.integer
elementalComposition :: Parser ElementalComposition
elementalComposition = mkElementalComposition <$> many subFormula
molecularFormula :: Parser MolecularFormula
molecularFormula = mkMolecularFormula <$> many subFormula
condensedFormula :: Parser CondensedFormula
condensedFormula = CondensedFormula <$> many (leftCondensedFormula <|> rightCondensedFormula)
where
subMolecularFormula :: Parser MolecularFormula
subMolecularFormula = mkMolecularFormula . pure <$> subFormula
leftCondensedFormula :: Parser (Either MolecularFormula (CondensedFormula, Int))
leftCondensedFormula = Left <$> subMolecularFormula
rightCondensedFormula :: Parser (Either MolecularFormula (CondensedFormula, Int))
rightCondensedFormula = do
_ <- char '('
formula <- condensedFormula
_ <- char ')'
num <- option 1 L.integer
return $ Right (formula, fromIntegral num)
empiricalFormula :: Parser EmpiricalFormula
empiricalFormula = mkEmpiricalFormula <$> many subFormula
quoteElementalComposition s =
case parse (condensedFormula <* eof) "" s of
Left err -> error $ "Could not parse formula: " <> show err
Right v -> lift $ toElementalComposition v
quoteMolecularFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $ "Could not parse formula: " <> show err
Right v -> lift $ toMolecularFormula v
quoteCondensedFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> error $ "Could not parse formula: " <> show err
Right v -> lift v
quoteEmpiricalFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $ "Could not parse formula: " <> show err
Right v -> lift $ toEmpiricalFormula v
ele :: QuasiQuoter
ele = QuasiQuoter
{ quoteExp = quoteElementalComposition }
mol :: QuasiQuoter
mol = QuasiQuoter
{ quoteExp = quoteMolecularFormula }
con :: QuasiQuoter
con = QuasiQuoter
{ quoteExp = quoteCondensedFormula }
emp :: QuasiQuoter
emp = QuasiQuoter
{ quoteExp = quoteEmpiricalFormula }
$(deriveLift ''ElementSymbol)
$(deriveLift ''ElementalComposition)
$(deriveLift ''MolecularFormula)
$(deriveLift ''CondensedFormula)
$(deriveLift ''EmpiricalFormula)
$(deriveLift ''Map)