haskell: 2023 07 cleanup

2023/haskell/aoc2023.cabal

@@ -28,7 +28,6 @@ library
 
   -- other-modules:
 
-  -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:
 
   build-depends:
@@ -46,7 +45,6 @@ executable aoc2023
   other-modules:
     Utils
 
-  -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:
 
   build-depends:
@@ -61,13 +59,10 @@ executable aoc2023
 test-suite aoc2023-test
   import: warnings
 
-  -- Modules included in this executable, other than Main.
   -- other-modules:
 
-  -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:
 
-  -- The interface type and version of the test suite.
   type: exitcode-stdio-1.0
 
   hs-source-dirs: tests

2023/haskell/solutions/Day03.hs

@@ -37,16 +37,15 @@ parse = first errorBundlePretty . runParser full ""
     full :: Parser [[Item]]
     full = many line <* eof
 
-findSpans :: (a -> a -> Bool) -> [a] -> [[a]]
+spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
-findSpans = helper []
+spansBy p = helper []
   where
-    helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
+    helper acc        []     = reverse . map reverse $ acc
-    helper acc        _ []     = reverse . map reverse $ acc
+    helper []         (x:xs) = helper [[x]] xs
-    helper []         p (x:xs) = helper [[x]] p xs
+    helper acc@(a:as) (x:xs) =
-    helper acc@(a:as) p (x:xs) =
       if p (head a) x
-      then helper ((x:a):as) p xs
+      then helper ((x:a):as) xs
-      else helper ([x]:acc)  p xs
+      else helper ([x]:acc)  xs
 
 withCoords :: [[a]] -> [((Row, Col), a)]
 withCoords grid = [((r, c), a) | (r, row) <- zip [0..] grid, (c, a) <- zip [0..] row]
@@ -75,7 +74,7 @@ getNumbers = concat . zipWith processRow [0..]
           e = maximum $ map fst items
       in (n, (r, s, e))
     processRow :: Row -> [Item] -> [(Int, (Row, Col, Col))]
-    processRow r = map (merge r) . findSpans isNext . mapMaybe getDigit . zip [0..]
+    processRow r = map (merge r) . spansBy isNext . mapMaybe getDigit . zip [0..]
 
 getNeigbors :: (Row, Col, Col) -> [(Row, Col)]
 getNeigbors (r, s, e) = [(r, s-1), (r, e+1)]

2023/haskell/solutions/Day07.hs

@@ -6,11 +6,11 @@ import Data.Char (isDigit, digitToInt)
 import Data.Text (Text)
 import Data.List (sort, find, sortBy)
 import Data.Function (on)
-import Data.Bifunctor (first, Bifunctor (bimap))
+import Data.Bifunctor (first, bimap, second)
+import Control.Monad (join)
 import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
 import Text.Megaparsec.Char (alphaNumChar, space)
 import Text.Megaparsec.Char.Lexer (decimal)
-import Control.Monad (join)
 
 
 data Card = X | Plain Int | T | J | Q | K | A
@@ -30,8 +30,8 @@ parse = first errorBundlePretty . runParser plays ""
   where
     card :: Char -> Card
     card c
-      | isDigit c = Plain $ digitToInt c
+      | isDigit c = Plain . digitToInt $ c
-      | otherwise = read $ pure c
+      | otherwise = read . pure $ c
     play :: Parser Play
     play = do
       cs  <- map card <$> many alphaNumChar
@@ -43,48 +43,43 @@ parse = first errorBundlePretty . runParser plays ""
     plays = many play <* eof
 
 spansBy :: (a -> a -> Bool) -> [a] -> [[a]]
-spansBy = helper []
+spansBy p = helper []
   where
-    helper :: [[a]] -> (a -> a -> Bool) -> [a] -> [[a]]
+    helper acc        []     = reverse . map reverse $ acc
-    helper acc        _ []     = reverse . map reverse $ acc
+    helper []         (x:xs) = helper [[x]] xs
-    helper []         p (x:xs) = helper [[x]] p xs
+    helper acc@(a:as) (x:xs) =
-    helper acc@(a:as) p (x:xs) =
       if p (head a) x
-      then helper ((x:a):as) p xs
+      then helper ((x:a):as) xs
-      else helper ([x]:acc)  p xs
+      else helper ([x]:acc)  xs
 
 group :: Hand -> [[Card]]
 group = spansBy (==) . sort
 
 classify :: Hand -> HandType
-classify cs
+classify = cast . sortBy (flip compare) . map length . group
-    | has [5]    = Five
-    | has [4]    = Four
-    | has [3, 2] = Full
-    | has [3]    = Three
-    | count 2 2  = TwoPair
-    | has [2]    = OnePair
-    | otherwise  = High
   where
-      sizes :: [Int]
+    cast :: [Int] -> HandType
-      sizes = map length . group $ cs
+    cast ns = case ns of
-      has :: [Int] -> Bool
+      5:_   -> Five
-      has   = all (`elem` sizes)
+      4:_   -> Four
-      count :: Int -> Int -> Bool
+      3:2:_ -> Full
-      count n = (==) . length . filter (n==) $ sizes
+      3:_   -> Three
+      2:2:_ -> TwoPair
+      2:_   -> OnePair
+      _     -> High
 
-withType :: Play -> (HandType, Play)
+withType :: (Hand -> HandType) -> Play -> (HandType, Play)
-withType = first (classify . fst) . join (,)
+withType toType = first (toType . fst) . join (,)
 
 score :: Int -> Play -> Int
 score = flip $ (*) . snd
 
 solveA :: [Play] -> Int
-solveA = sum . zipWith score [1..] . map snd . sort . map withType
+solveA = sum . zipWith score [1..] . map snd . sort . map (withType classify)
 
-classify' :: [Card] -> HandType
+classify' :: Hand -> HandType
 classify' cs =
-  let counts = map (bimap length head . join (,)) . spansBy (==) . sort $ cs
+  let counts = map (bimap length head . join (,)) . group $ cs
       jokers = maybe 0 fst . find ((J ==) . snd) $ counts
       others = sortBy (flip compare `on` fst) . filter ((J /=) . snd) $ counts
   in case others of
@@ -99,8 +94,5 @@ erase e = helper
       | e == c    = X : helper cs
       | otherwise = c : helper cs
 
-withType' :: Play -> (HandType, Play)
-withType' = bimap (classify' . fst) (first (erase J)) . join (,)
-
 solveB :: [Play] -> Int
-solveB = sum . zipWith score [1..] . map snd . sort . map withType'
+solveB = sum . zipWith score [1..] . map snd . sort . map (second (first $ erase J) . withType classify')