Solve 2023-01

src/AoC/Y2023/D01.hs

@@ -2,5 +2,67 @@ module AoC.Y2023.D01 (solve) where
 
 import AoC.Riddle
 
+extract1 :: [Int] -> String -> [Int]
+extract1 ds [] = reverse ds
+extract1 ds ('1' : xs) = extract1 (1 : ds) xs
+extract1 ds ('2' : xs) = extract1 (2 : ds) xs
+extract1 ds ('3' : xs) = extract1 (3 : ds) xs
+extract1 ds ('4' : xs) = extract1 (4 : ds) xs
+extract1 ds ('5' : xs) = extract1 (5 : ds) xs
+extract1 ds ('6' : xs) = extract1 (6 : ds) xs
+extract1 ds ('7' : xs) = extract1 (7 : ds) xs
+extract1 ds ('8' : xs) = extract1 (8 : ds) xs
+extract1 ds ('9' : xs) = extract1 (9 : ds) xs
+extract1 ds (_ : xs) = extract1 ds xs
+
+extract2 :: [Int] -> String -> [Int]
+extract2 ds [] = reverse ds
+extract2 ds s@(_ : t) =
+  case s of
+    ('1' : _) -> extract2 (1 : ds) t
+    ('2' : _) -> extract2 (2 : ds) t
+    ('3' : _) -> extract2 (3 : ds) t
+    ('4' : _) -> extract2 (4 : ds) t
+    ('5' : _) -> extract2 (5 : ds) t
+    ('6' : _) -> extract2 (6 : ds) t
+    ('7' : _) -> extract2 (7 : ds) t
+    ('8' : _) -> extract2 (8 : ds) t
+    ('9' : _) -> extract2 (9 : ds) t
+    ('o' : 'n' : 'e' : _) -> extract2 (1 : ds) t
+    ('t' : 'w' : 'o' : _) -> extract2 (2 : ds) t
+    ('t' : 'h' : 'r' : 'e' : 'e' : _) -> extract2 (3 : ds) t
+    ('f' : 'o' : 'u' : 'r' : _) -> extract2 (4 : ds) t
+    ('f' : 'i' : 'v' : 'e' : _) -> extract2 (5 : ds) t
+    ('s' : 'i' : 'x' : _) -> extract2 (6 : ds) t
+    ('s' : 'e' : 'v' : 'e' : 'n' : _) -> extract2 (7 : ds) t
+    ('e' : 'i' : 'g' : 'h' : 't' : _) -> extract2 (8 : ds) t
+    ('n' : 'i' : 'n' : 'e' : _) -> extract2 (9 : ds) t
+    (_ : _) -> extract2 ds t
+
+digitsPart1 :: String -> NonEmpty Int
+digitsPart1 s = case nonEmpty $ extract1 [] s of
+  Just xs -> xs
+  Nothing -> 0 :| []
+
+digitsPart2 :: String -> NonEmpty Int
+digitsPart2 s = case nonEmpty $ extract2 [] s of
+  Just xs -> xs
+  Nothing -> 0 :| []
+
+calibrationValue :: (String -> NonEmpty Int) -> String -> Int
+calibrationValue digits s = firstDigit * 10 + lastDigit
+ where
+  ds = digits s
+  firstDigit = head ds
+  lastDigit = last ds
+
+solvePart :: (String -> NonEmpty Int) -> Text -> Integer
+solvePart digits = fromIntegral . sum . fmap (calibrationValue digits . toString) . lines
+
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve _ = pure $ Left "not yet implemented"
+solve input =
+  pure $
+    Right
+      [ solvePart digitsPart1 input
+      , solvePart digitsPart2 input
+      ]