Add operator support to format

common/src/Advent/Format/Types.hs

@@ -188,5 +188,53 @@ enumCases nameStr =
       case con of
         NormalC name []
           | Just str <- stripPrefix nameStr (nameBase name) ->
-            pure (name, str)
+            case str of
+              '_' : symbolName ->
+                do symbol <- processSymbolName symbolName
+                   pure (name, symbol)
+              _ -> pure (name, str)
         _ -> fail ("Unsupported constructor: " ++ show con)
+
+processSymbolName :: String -> Q String
+processSymbolName str =
+  case break ('_' ==) str of
+    (name, rest) ->
+      case lookup name symbolNames of
+        Nothing -> fail ("Unknown symbol name: " ++ name)
+        Just symbol ->
+          case rest of
+            [] -> pure [symbol]
+            _:str' -> (symbol:) <$> processSymbolName str'
+
+symbolNames :: [(String, Char)]
+symbolNames =
+  [ ("LT", '<')
+  , ("GT", '>')
+  , ("EQ", '=')
+  , ("BANG", '!')
+  , ("AT" , '@')
+  , ("HASH", '#')
+  , ("DOLLAR", '$')
+  , ("PERCENT", '%')
+  , ("CARET", '^')
+  , ("AMPERSAND", '&')
+  , ("STAR", '*')
+  , ("PIPE", '|')
+  , ("LPAREN", '(')
+  , ("RPAREN", ')')
+  , ("LBRACE", '{')
+  , ("RBRACE", '}')
+  , ("LBRACK", '[')
+  , ("RBRACK", ']')
+  , ("COLON", ':')
+  , ("SEMI", ';')
+  , ("QUESTION", '?')
+  , ("SLASH", '/')
+  , ("BACKSLASH", '\\')
+  , ("UNDERSCORE", '_')
+  , ("DASH", '-')
+  , ("DOT", '.')
+  , ("COMMA", ',')
+  , ("PLUS", '+')
+  , ("TILDE", '~')
+  ]

solutions/src/2023/19.hs

@@ -46,13 +46,13 @@ data Part a = Part a a a a
 -- | 'V' is an index into a field of a 'Part'
 data V = Vx | Vm | Va | Vs
 
+data O = O_LT | O_GT
+
 -- | 'Ints' is a range of 'Int' with an inclusive lower bound and exclusive upper bound.
 type Ints = Box' 1
 
--- | Workflow rule determine an action to take based on parameter value.
-data Rule
-   = LessThan    V Int String -- ^ Action when variable less-than bound
-   | GreaterThan V Int String -- ^ Action when variable greater-than bound
+-- | A rule is a part field, an operator, a bound, and a jump target
+type Rule = (V, O, Int, String)
 
 stageTH
 
@@ -63,18 +63,13 @@ stageTH
 -- 127517902575337
 main :: IO ()
 main =
- do (workflows_, parts_) <- [format|2023 19 (%a+{((@V(<|>)!%d:%a+),)*%a+}%n)*%n({x=%d,m=%d,a=%d,s=%d}%n)*|]
-    let workflows = Map.fromList [(k, (map toRule rs, e)) | (k, rs, e) <- workflows_]
+ do (workflows_, parts_) <- [format|2023 19 (%a+{((@V@O%d:%a+),)*%a+}%n)*%n({x=%d,m=%d,a=%d,s=%d}%n)*|]
+    let workflows = Map.fromList [(k, (rs, e)) | (k, rs, e) <- workflows_]
         parts = [Part x m a s | (x, m, a, s) <- parts_]
     print (sum [sum p | p <- parts, accepted workflows p])
     let full = 1 :> 4001
     print (acceptedCount workflows (Part full full full full))
 
--- | Convert parsed syntax to semantic representation
-toRule :: (V, String, Int, String) -> Rule
-toRule (v, ">", n, lbl) = GreaterThan v n lbl
-toRule (v, _  , n, lbl) = LessThan    v n lbl
-
 -- | Predicate for parts that will be accepted by the workflow.
 accepted :: Map String ([Rule], String) -> Part Int -> Bool
 accepted workflows xmas = 0 /= acceptedCount workflows (fmap one xmas)
@@ -89,13 +84,13 @@ acceptedCount workflows = jump "in"
     jump "R"                             = const 0
     jump ((workflows Map.!) -> (rs, el)) = foldr rule (jump el) rs
 
-    rule (GreaterThan var n tgt) continue p =
+    rule (var, O_GT, n, tgt) continue p =
       case split (n + 1) (lkp p var) of
         (lo, hi) ->
           maybe 0 (continue . set p var) lo +
           maybe 0 (jump tgt . set p var) hi
 
-    rule (LessThan var n tgt) continue p =
+    rule (var, O_LT, n, tgt) continue p =
       case split n (lkp p var) of
         (lo, hi) ->
           maybe 0 (jump tgt . set p var) lo +