Merge pull request #176 from isovector/math

Add simple math evaluation

doc/arbtt.xml

@@ -300,7 +300,7 @@
       These expressions can be compared to integers.
       Expression <literal>week of year $date</literal> evaluates to an integer,
       from 0 to 53, corresponding to the week of year. January 1 falls in week 0.
-      These expressions can be compared to integers.
+      These expressions are integers, and can be combined and compared as such.
     </para>
 
     <para>
@@ -316,6 +316,12 @@
       succeeds if any of them succeeds.
     </para>
 
+    <para>
+      Integer expressions can be combined via <literal>+</literal>
+      (addition), <literal>-</literal> (subtraction), <literal>*</literal> (multiplication),
+      operators.
+    </para>
+
     <para>Regular expressions are written either between slashes
        (<literal>/</literal> regular expression <literal>/</literal>),
        or after a letter <literal>m</literal> followed by any symbol
@@ -458,6 +464,8 @@
         <rhs> <quote>week of year</quote> <nonterminal def="#g-date" /> </rhs>
         <rhs> <quote>month</quote> <nonterminal def="#g-date" /> </rhs>
         <rhs> <quote>year</quote> <nonterminal def="#g-date" /> </rhs>
+        <rhs> <nonterminal def="#g-number"/> <nonterminal def="#g-mathop"/>
+         <nonterminal def="#g-number"/> </rhs>
         <rhs> number literal </rhs>
       </production>
 
@@ -502,6 +510,12 @@
         | <quote>&gt;</quote> | <quote>&gt;=</quote></rhs>
       </production>
 
+      <production id="g-mathop">
+        <lhs>MathOp</lhs>
+        <rhs><quote>+</quote> | <quote>-</quote> |
+        <quote>*</quote></rhs>
+      </production>
+
       <production id="g-condition">
         <lhs>ConditionBinding</lhs>
         <rhs><quote>condition</quote> Literal <quote>=</quote> <nonterminal def="#g-cond"/> <quote>in</quote> <nonterminal def="#g-rule"/></rhs>

src/Categorize.hs

@@ -69,6 +69,7 @@ data CondPrim
         | CondRegexList (CtxFun [RE.Regex])
 
 newtype Cmp = Cmp (forall a. Ord a => a -> a -> Bool)
+newtype Math = Math (forall a. Num a => a -> a -> a)
 
 data DateVar = DvDate | DvNow
 
@@ -226,6 +227,8 @@ parseCondExpr = buildExpressionParser [
                 , Prefix (reserved lang "month" >> return evalMonth)
                 , Prefix (reserved lang "year" >> return evalYear)
                 , Prefix (reserved lang "format" >> return formatDate) ],
+                [ Infix (evalMath <$> parseMath) AssocLeft
+                ],
                 [ Infix (reservedOp lang "=~" >> return checkRegex) AssocNone
                 , Infix (checkCmp <$> parseCmp) AssocNone
                 ],
@@ -283,6 +286,15 @@ checkNot cp = Left $
         printf "Cannot apply ! to an expression of type %s"
                (cpType cp)
 
+evalMath :: Math -> CondPrim -> CondPrim -> Erring CondPrim
+evalMath (Math (?)) (CondInteger getN1) (CondInteger getN2) = Right $ CondInteger $ \ctx -> do
+        n1 <- getN1 ctx
+        n2 <- getN2 ctx
+        return $ n1 ? n2
+evalMath _ cp1 cp2 = Left $
+        printf "Cannot do math on expressions of type %s and type %s"
+               (cpType cp1) (cpType cp2)
+
 checkCmp :: Cmp -> CondPrim -> CondPrim -> Erring CondPrim
 checkCmp (Cmp (?)) (CondInteger getN1) (CondInteger getN2) = Right $ CondCond $ \ctx -> do
         n1 <- getN1 ctx
@@ -390,6 +402,13 @@ formatDate (CondDate df) = Right $ CondString $ \ctx ->
 formatDate cp = Left $ printf
   "Cannot format an expression of type %s, only $date." (cpType cp)
 
+parseMath :: Parser Math
+parseMath = choice $ map (\(s,o) -> reservedOp lang s >> return o)
+                        [("+",Math (+)),
+                         ("-", Math (-)),
+                         ("*",Math (*))
+                         ]
+
 parseCmp :: Parser Cmp
 parseCmp = choice $ map (\(s,o) -> reservedOp lang s >> return o)
                         [(">=",Cmp (>=)),