day16/haskell: readability improvements

day14/day14.hs

@@ -5,6 +5,7 @@ module Day14 where
 import AoC
 
 import Data.Bits
+import Data.List
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
@@ -26,7 +27,7 @@ parseMaskDecl :: ReadP Mask
 parseMaskDecl = do
     string "mask = "
     mask <- many1 (choice $ char <$> "01X")
-    let extractMask c = foldl setBit zeroBits . map fst . filter ((==c) . snd) . enumerate 0 . reverse $ mask
+    let extractMask c = foldl setBit zeroBits . findIndices (==c) . reverse $ mask
     return $ Mask { set = extractMask '1'
                   , clear = extractMask '0'
                   , dontcare = extractMask 'X'

day16/day16.hs

@@ -53,33 +53,32 @@ parseInput = do
     return $ Input {fields, myTicket, otherTickets }
 
 matchesAnyField :: [Field] -> Int -> Bool
-matchesAnyField fields n = any (n `S.member`) . map valids $ fields
+matchesAnyField fields n = any ((n `S.member`) . valids) fields
 
-iterateUntilDone :: (a -> Maybe a) -> a -> a
+iterateUntilNothing :: (a -> Maybe a) -> a -> a
-iterateUntilDone f x = case f x of
+iterateUntilNothing f x = maybe x (iterateUntilNothing f) $ f x
-                         Just x' -> iterateUntilDone f x'
-                         Nothing -> x
 
 data Resolve a = Resolved a | Choice (Set a) deriving (Show)
 
 resolve :: Ord a => [[a]] -> Maybe [a]
-resolve = sequence . map fromResolved . iterateUntilDone resolve' . map (Choice . S.fromList)
+resolve = sequence . map fromResolved . iterateUntilNothing resolve' . map (Choice . S.fromList)
     where fromResolved (Resolved x) = Just x
           fromResolved _ = Nothing
 
 findSingletonChoice :: [Resolve a] -> Maybe (a, [Resolve a])
-findSingletonChoice (c@(Choice s):xs) | S.size s == 1 = let [x] = S.elems s
+findSingletonChoice [] = Nothing
-                                                        in Just (x, Resolved x:xs)
+findSingletonChoice (x:xs) =
-                                      | otherwise = (fmap.fmap) (c:) $ findSingletonChoice xs
+    case x of
-findSingletonChoice (x:xs) = (fmap.fmap) (x:) $ findSingletonChoice xs
+      Choice s | S.size s == 1 -> let [r] = S.elems s
-findSingletonChoice _ = Nothing
+                                  in  Just (r, Resolved r : xs)
+      _ -> fmap (\(r, rest) -> (r, x:rest)) $ findSingletonChoice xs
 
 resolve' :: Ord a => [Resolve a] -> Maybe [Resolve a]
 resolve' xs = do
-    (x, xs') <- findSingletonChoice xs
+    (r, xs') <- findSingletonChoice xs
-    return $ map (dropChoice x) xs'
+    return $ map (dropChoice r) xs'
     where dropChoice x (Choice s) = Choice (S.delete x s)
-          dropChoice _ r = r
+          dropChoice _ y = y
 
 part1 :: Input -> Int
 part1 Input { fields, otherTickets } = sum . filter (not . matchesAnyField fields) . concat $ otherTickets