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.Syntax
import Language.Haskell.TH.Lift
import Text.Megaparsec
import Text.Megaparsec.String
import qualified Text.Megaparsec.Lexer as L
import Data.List
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 :: String -> Q Exp
quoteElementalComposition s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $
"Could not parse elemental formula!\n" <> parseErrorPretty err
Right v -> lift $ toElementalComposition v
quoteMolecularFormula :: String -> Q Exp
quoteMolecularFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $
"Could not parse molecular formula!\n" <> parseErrorPretty err
Right v -> lift $ toMolecularFormula v
quoteCondensedFormula :: String -> Q Exp
quoteCondensedFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $
"Could not parse condensed formula!\n" <> parseErrorPretty err
Right v -> lift v
quoteEmpiricalFormula s =
case parse (condensedFormula <* eof) "" s of
Left err -> fail $
"Could not parse empirical formula!\n" <> parseErrorPretty err
Right v -> lift $ toEmpiricalFormula v
ele :: QuasiQuoter
ele = QuasiQuoter {
quoteExp = quoteElementalComposition
, quotePat = notHandled "patterns" "elemental composition"
, quoteType = notHandled "types" "elemental composition"
, quoteDec = notHandled "declarations" "elemental composition"
}
mol :: QuasiQuoter
mol = QuasiQuoter {
quoteExp = quoteMolecularFormula
, quotePat = notHandled "patterns" "molecular formula"
, quoteType = notHandled "types" "molecular formula"
, quoteDec = notHandled "declarations" "molecular formula"
}
con :: QuasiQuoter
con = QuasiQuoter {
quoteExp = quoteCondensedFormula
, quotePat = notHandled "patterns" "condensed formula"
, quoteType = notHandled "types" "condensed formula"
, quoteDec = notHandled "declarations" "condensed formula"
}
emp :: QuasiQuoter
emp = QuasiQuoter {
quoteExp = quoteEmpiricalFormula
, quotePat = notHandled "patterns" "empirical formula"
, quoteType = notHandled "types" "empirical formula"
, quoteDec = notHandled "declarations" "empirical formula"
}
notHandled :: String -> String -> a
notHandled feature quoterName =
error $ feature <> " are not handled by the" <> quoterName <> "quasiquoter."
$(deriveLift ''ElementSymbol)
$(deriveLift ''ElementalComposition)
$(deriveLift ''MolecularFormula)
$(deriveLift ''CondensedFormula)
$(deriveLift ''EmpiricalFormula)
$(deriveLift ''Map)