Allow gather to return parsed value

common/src/Advent/Format.hs

@@ -122,7 +122,9 @@ toReadP s =
   case s of
     Literal xs -> [| void (string xs) |]
 
-    Gather p -> [| fst <$> gather $(toReadP p) |]
+    Gather p
+      | interesting p -> [|         gather $(toReadP p) |]
+      | otherwise     -> [| fst <$> gather $(toReadP p) |]
 
     Named n
       | isUpper (head n) -> enumParser n
@@ -191,7 +193,9 @@ toType fmt =
   case fmt of
     Literal _ -> [t| () |]
 
-    Gather _ -> [t| String |]
+    Gather x
+      | interesting x -> [t| (String, $(toType x)) |]
+      | otherwise     -> [t| String |]
 
     Named n
       | isUpper (head n) -> conT (mkName n)

solutions/src/2020/07.hs

@@ -22,8 +22,8 @@ import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (fromMaybe)
 
-type Bag = String
-type Rule = (String, Maybe [(Integer, String)])
+type Bag = (String, String)
+type Rule = (Bag, Maybe [(Integer, Bag)])
 
 ------------------------------------------------------------------------
 
@@ -33,9 +33,9 @@ type Rule = (String, Maybe [(Integer, String)])
 -- 7867
 main :: IO ()
 main =
-  do rules <- [format|2020 7 ((%s %s)! bags contain (no other bags|(%lu (%s %s)! bag(|s))&(, )).%n)*|]
+  do rules <- [format|2020 7 ((%s %s) bags contain (no other bags|(%lu (%s %s) bag(|s))&(, )).%n)*|]
      let tc = transClosBags rules
-         k = "shiny gold"
+         k = ("shiny", "gold")
      print (countBy (Map.member k) tc)
      print (sum (tc Map.! k))
 

solutions/src/2023/15.hs

@@ -26,17 +26,15 @@ import Data.Char (ord)
 -- 261505
 main :: IO ()
 main =
- do input <- [format|2023 15 (%a+(-|=%d))&,%n|]
-    print (sum (map (hasher . unparse) input))
+ do input <- [format|2023 15 (%a+(-|=%d))!&,%n|]
+    print (sum (map (hasher . fst) input))
 
-    let boxes = accumArray apply [] (0, 255) [(hasher lbl, (lbl, cmd)) | (lbl, cmd) <- input]
-    print (sum [ (1+box) * i * len | (box, xs) <- assocs boxes, (i, (_ ,len)) <- zip [1..] xs ])
+    let boxes = accumArray apply [] (0, 255)
+                  [(hasher lbl, (lbl, cmd)) | (_, (lbl, cmd)) <- input]
 
--- I don't have a nice way to both get the input unparsed and also parsed
--- without doing a second pass of parsing - this seemed easier
-unparse :: (String, Maybe Int) -> String
-unparse (lbl, Nothing) = lbl ++ "-"
-unparse (lbl, Just n ) = lbl ++ "=" ++ show n
+    print (sum [ (1+box) * i * len
+               | (box, xs)     <- assocs boxes
+               , (i, (_, len)) <- zip [1..] xs])
 
 hasher :: String -> Int
 hasher = foldl (\acc x -> 17 * (ord x + acc) `rem` 256) 0
@@ -45,6 +43,6 @@ apply :: [(String, Int)] -> (String, Maybe Int) -> [(String, Int)]
 apply prev (lbl, Nothing) = filter ((lbl /=) . fst) prev
 apply prev (lbl, Just n ) = go prev
   where
-    go [] = [(lbl, n)]
     go ((k,_) : xs) | lbl == k = (lbl, n) : xs
-    go (x : xs) = x : go xs
+    go (x     : xs)            = x : go xs
+    go []                      = [(lbl, n)]