chemical-equation 0.0.1 → 0.0.2
raw patch · 2 files changed
+84/−26 lines, 2 files
Files
- chemical-equation.cabal +9/−2
- src/Common.hs +75/−24
chemical-equation.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: chemical-equation-Version: 0.0.1+Version: 0.0.2 Synopsis: Balance chemical equations Description: Balance coefficients of chemical equations.@@ -19,6 +19,9 @@ > $ balance-chemical-equation C8H18 O2 CO2 H2O > 2 C8H18 + 25 O2 <=> 16 CO2 + 18 H2O .+ > $ balance-chemical-equation NH4Cl "Ca(OH)2" NH3 CaCl2 H2O+ > 2 NH4Cl + Ca(OH)2 <=> 2 NH3 + CaCl2 + 2 H2O+ . You may use a custom reaction arrow: . > $ balance-chemical-equation --arrow="->" HCl NaOH NaCl H2O@@ -28,6 +31,10 @@ . > $ balance-chemical-equation --unicode --arrow=$'\u21CC' N2 H2 NH3 .+ Ion charges in @mhchem@ notation:+ .+ > $ balance-chemical-equation --unicode --arrow=$'\u2192' Ca^2+ Cl^- CaCl2+ . If you mix multiple reactions then the program takes them apart, again. However, the resulting partial reactions may not be chemically sensible.@@ -69,7 +76,7 @@ Default: False Source-Repository this- Tag: 0.0.1+ Tag: 0.0.2 Type: darcs Location: https://hub.darcs.net/thielema/chemical-equation
src/Common.hs view
@@ -14,9 +14,12 @@ import Data.Set (Set) import Data.Maybe (mapMaybe, isNothing) import Data.Tuple.HT (mapPair, mapSnd, swap)+import Data.Bool.HT (if') +import qualified Text.Parsec.Pos as SourcePos import qualified Text.Parsec as Parsec import Text.Parsec.String (Parser)+import Text.Parsec ((<|>)) import Text.Printf (printf) @@ -25,31 +28,70 @@ import qualified Shell.Utility.Log as Log import Shell.Utility.Verbosity (Verbosity) -import Control.Monad (when)-import Control.Applicative (liftA2, liftA3, (<$>))+import Control.Monad (when, void)+import Control.Applicative (liftA2, liftA3, (<$>), (<*)) type Reactant = Map String Integer +consuming :: Parser a -> Parser (String, a)+consuming p = do+ input <- Parsec.getInput+ posBefore <- Parsec.getPosition+ result <- p+ posAfter <- Parsec.getPosition+ return+ (take (SourcePos.sourceColumn posAfter+ - SourcePos.sourceColumn posBefore) input,+ result)++parseElement :: Parser Reactant+parseElement =+ flip Map.singleton 1 <$> liftA2 (:) Parsec.upper (Parsec.many Parsec.lower)++parseMultiplicity :: String -> Parser Integer+parseMultiplicity partStr = do+ kStr <- Parsec.many Parsec.digit+ case (kStr, read kStr) of+ ("", _) -> return 1+ {- ToDo:+ should be an unrecoverable parser error+ in order to not generate confusing additional errors,+ e.g. when parsing C0+ -}+ (_, 0) ->+ Parsec.unexpected $+ printf "%s has multiplicity zero" partStr+ (_, k) -> return k++chargeStr :: String+chargeStr = "charge"++parseCharge :: Parser Reactant+parseCharge = do+ void $ Parsec.char '^'+ k <- parseMultiplicity chargeStr+ c <- k <$ Parsec.char '+' <|> (-k) <$ Parsec.char '-'+ return $ Map.singleton chargeStr c++parsePart :: Parser Reactant+parsePart =+ fmap (Map.unionsWith (+)) $+ flip Parsec.sepBy1 (Parsec.optional (Parsec.char '-')) $ do+ (partStr,part) <-+ consuming $+ Parsec.between (Parsec.char '(') (Parsec.char ')') parsePart+ <|>+ parseCharge+ <|>+ parseElement+ k <- parseMultiplicity partStr+ return ((k*) <$> part)+ parseReactant :: Parser Reactant-parseReactant =- fmap (Map.fromListWith (+)) $- Parsec.many1 $ do- element <- liftA2 (:) Parsec.upper (Parsec.many Parsec.lower)- kStr <- Parsec.many Parsec.digit- case (kStr, read kStr) of- ("", _) -> return (element, 1)- {- ToDo:- should be an unrecoverable parser error- in order to not generate confusing additional errors,- e.g. when parsing C0- -}- (_, 0) ->- Parsec.unexpected $- printf "element %s has multiplicity zero" element- (_, k) -> return (element, k)+parseReactant = parsePart <* Parsec.eof preprocessArguments :: Verbosity -> [String] -> IO (Set Reactant, [(Reactant, String)])@@ -105,20 +147,29 @@ type Format = [(Reactant,String)] -> Map Reactant Integer -> String +toUnicode :: String -> String+toUnicode =+ let go [] = []+ go (c:cs) =+ if' (c=='^')+ (case mapSnd (splitAt 1) $ span Char.isDigit cs of+ (ds, (sign,remnd)) ->+ map Unicode.superscript (ds++sign) ++ go remnd) $+ if' (Char.isDigit c) (Unicode.subscript c : go cs) $+ c : go cs+ in go+ formatEquation :: Bool -> String -> Format formatEquation useUnicode arrow rs reactantMap =- let applyCond b f x = if b then f x else x- toSubscript =- applyCond useUnicode- (map (\c -> applyCond (Char.isDigit c) Unicode.subscript c))+ let eyeCandy = if useUnicode then toUnicode else id tagged = mapMaybe (\(r,name) -> let n = reactantMap Map.! r in case compare n 0 of EQ -> Nothing- GT -> Just $ (True, ( n, toSubscript name))- LT -> Just $ (False, (-n, toSubscript name)))+ GT -> Just $ (True, ( n, eyeCandy name))+ LT -> Just $ (False, (-n, eyeCandy name))) rs (lhs,rhs) = (case tagged of ((True,_):_) -> id; _ -> swap) $