Solve 2023-01

aoc.cabal

@@ -132,6 +132,7 @@ test-suite spec
   main-is: Spec.hs
   other-modules:
       AoCSpec.UtilSpec
+      AoCSpec.Y2023Spec
       SpecHook
       Paths_aoc
   autogen-modules:

src/AoC.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module AoC (
   defaultMain,
+  runAoC,
+  module AoC.Day,
+  module AoC.Year,
 ) where
 
 import AoC.Day
@@ -14,17 +15,18 @@ import System.IO.Error qualified as IOError
 
 import AoC.Y2023 qualified as Y2023
 
-runAoC :: (MonadIO m) => [String] -> m ()
-runAoC _args = do
-  riddle <- loadRiddle Y2023 D01
-  result <- Y2023.solve D01 riddle
-  print result
+runAoC :: (MonadIO m) => Year -> Day -> m (Either Text Solution)
+runAoC y d = do
+  riddle <- loadRiddle y d
+  solve y d riddle
+
+solve :: (MonadIO m) => Year -> Day -> Riddle -> m (Either Text Solution)
+solve Y2023 = Y2023.solve
+solve y = \_ _ -> pure $ Left $ show y <> ": not implementedi"
 
 handleError :: IOError.IOError -> IO ()
 handleError e = do
   hPutStrLn stderr $ "I ran into an issue: " <> show e
 
 defaultMain :: IO ()
-defaultMain = do
-  args <- getArgs
-  Exception.catch (runAoC args) handleError
+defaultMain = Exception.catch (runAoC Y2023 D01 >>= print) handleError

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
+      ]

test/spec/AoCSpec/Y2023Spec.hs

@@ -0,0 +1,10 @@
+module AoCSpec.Y2023Spec (spec) where
+
+import AoC
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "Day 1" do
+    it "calculates correctly" do
+      runAoC Y2023 D01 `shouldReturn` Right [54331, 54518]