Fix Day1 to be more elegant

src/advent_of_code/2023/1.hs

@@ -1,20 +1,20 @@
 -- https://adventofcode.com/2023/day/1
 
-import           Data.Bifunctor               (bimap)
+import           Data.Bifunctor               (bimap, second)
-import           Data.Maybe                   (fromMaybe)
+import           Data.Maybe                   (fromJust, fromMaybe, isJust)
+import           Data.Text                    (Text, pack, replace, unpack)
 import           Text.ParserCombinators.ReadP (ReadP, choice, many, readP_to_S,
                                                string, (<++))
 
 main :: IO ()
 main = do
   entries <- lines <$> readFile "src/advent_of_code/2023/input1"
-  print "Advent of Code 2022 - Day 4"
+  print "Advent of Code 2023 - Day 1"
   -- print entries
 
   print ("Part 1: " <> show (solveP1 entries))
   print ("Part 2: " <> show (solveP2 entries))
 
-
 --
 -- Part 1
 --
@@ -36,26 +36,11 @@ solveP2 :: [String] -> Int
 solveP2 = sum . map solveP2Line
 
 solveP2Line :: String -> Int
-solveP2Line = sumPairS . bimap a b . doubleString
+solveP2Line = sumPairS . bimap head last . doubleString . map stringToNum . filter isNumP2 . tokenized tokensP2 . replaceAll overlaps
-  where
-    a = head . condense . fromLeft
-    b = last . condense . fromRight
-    -- Need to parse from both sides
-    -- "oneight" should return 18, not 11
-
-    condense  = map stringToNum . filter isNumP2
-    fromLeft  =                         tokenized tokensP2
-    fromRight = map reverse . reverse . tokenized tokensP2' . reverse
 
 tokensP2 :: ReadP String
 tokensP2 = parseNumberWords <++ parseNumberChars <++ parseChars
 
-tokensP2' :: ReadP String
-tokensP2' = parseNumberWords' <++ parseNumberChars <++ parseChars
-
-solveP2LineBad :: String -> Int
-solveP2LineBad = sumPairS . bimap head last . doubleString . map stringToNum . filter isNumP2 . tokenized tokensP2
-
 --
 -- Utility functions
 --
@@ -94,47 +79,64 @@ numberChars = map show [0..9]
 numberWords :: [String]
 numberWords = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"]
 
-overlapsSpec :: [(String, String)]
+parseChars :: ReadP String
-overlapsSpec =
+parseChars = choice $ map (\c -> string [c]) letterChars
-  [ ("zero" , "one"  )
-  , ("one"  , "eight")
-  , ("two"  , "one"  )
-  , ("three", "eight")
-  , ("five" , "eight")
-  , ("seven", "nine" )
-  , ("eight", "two"  )
-  , ("eight", "three")
-  , ("nine" , "eight")
-  ]
-
-overlapsDerived :: [(String, [String])]
-overlapsDerived = zip numberWords $ map findOverlaps numberWords
-
-findOverlaps :: String -> [String]
-findOverlaps str = filter (\s -> last str == head s) numberWords
-
-combineOverlaps :: (String, [String]) -> [String]
-combineOverlaps (numStr, []       ) = []
-combineOverlaps (numStr, over:laps) = (numStr ++ tail over) : combineOverlaps (numStr, laps)
-
-overlaps :: [String]
-overlaps = filter (/= "") $ concatMap combineOverlaps overlapsDerived
-
-parseNumberWords :: ReadP String
-parseNumberWords = choice $ map string numberWords
-
-parseNumberWords' :: ReadP String
-parseNumberWords' = choice $ map (string . reverse) numberWords
 
 parseNumberChars :: ReadP String
 parseNumberChars = choice $ map string numberChars
 
-parseChars :: ReadP String
+parseNumberWords :: ReadP String
-parseChars = choice $ map (\c -> string [c]) letterChars
+parseNumberWords = choice $ map string numberWords
 
 tokenized :: ReadP a -> String -> [a]
 tokenized tokenSet = fst . last . readP_to_S (many tokenSet)
 
+--
+-- Detecting overlaps
+--   - Instead of reversing to tokenize from the right, I'm using the numberWords list to create a set of possible string overlaps
+--   -   later I'll detect these and replace them, to be able to parse all strings from left to right
+--
+
+overlaps :: [(String, String)]
+overlaps = concatMap combineOverlaps overlapsDerived
+
+-- Not used, but the full list written manually
+overlapsSpec :: [((String, String), String)]
+overlapsSpec =
+  [ (("zero" , "one"  ), "01")
+  , (("one"  , "eight"), "18")
+  , (("two"  , "one"  ), "21")
+  , (("three", "eight"), "38")
+  , (("five" , "eight"), "58")
+  , (("seven", "nine" ), "79")
+  , (("eight", "two"  ), "82")
+  , (("eight", "three"), "83")
+  , (("nine" , "eight"), "98")
+  ]
+
+overlapsDerived :: [(String, [String])]
+overlapsDerived = map (second fromJust) . filter (isJust . snd) . zip numberWords $ map findOverlaps numberWords
+  where
+    findOverlaps :: String -> Maybe [String]
+    findOverlaps str = if null overlaps then Nothing else Just overlaps
+      where
+        overlaps = filter (\s -> last str == head s) numberWords
+
+combineOverlaps :: (String, [String]) -> [(String, String)]
+combineOverlaps (numStr, []       ) = []
+combineOverlaps (numStr, over:laps) = (numStr ++ tail over, stringToNum numStr ++ stringToNum over) : combineOverlaps (numStr, laps)
+
+-- String replace using Text lol
+replace' :: String -> String -> String -> String
+replace' needle replacement haystack = unpack $ replace needle' replacement' haystack'
+  where
+    needle'      = pack needle
+    replacement' = pack replacement
+    haystack'    = pack haystack
+
+replaceAll :: [(String, String)] -> String -> String
+replaceAll overlaps str = foldl (\haystack (needle, replacement) -> replace' needle replacement haystack) str overlaps
+
 --
 -- Examples
 --