Solve 2023-05

data/Y2023/D05/example

@@ -0,0 +1,33 @@
+seeds: 79 14 55 13
+
+seed-to-soil map:
+50 98 2
+52 50 48
+
+soil-to-fertilizer map:
+0 15 37
+37 52 2
+39 0 15
+
+fertilizer-to-water map:
+49 53 8
+0 11 42
+42 0 7
+57 7 4
+
+water-to-light map:
+88 18 7
+18 25 70
+
+light-to-temperature map:
+45 77 23
+81 45 19
+68 64 13
+
+temperature-to-humidity map:
+0 69 1
+1 0 69
+
+humidity-to-location map:
+60 56 37
+56 93 4

src/AoC.hs

@@ -1,6 +1,7 @@
 module AoC (
   defaultMain,
   runAoC,
+  runAoCExample,
   module AoC.Day,
   module AoC.Year,
 ) where
@@ -20,6 +21,11 @@ runAoC y d = do
   riddle <- loadRiddle y d
   solve y d riddle
 
+runAoCExample :: (MonadIO m) => Year -> Day -> m (Either Text Solution)
+runAoCExample y d = do
+  riddle <- loadExample 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"

src/AoC/Y2023/D05.hs

@@ -1,6 +1,46 @@
-module AoC.Y2023.D05 (solve) where
+module AoC.Y2023.D05 where
 
+import AoC.Parser
 import AoC.Riddle
+import Text.Megaparsec (choice, sepBy1)
+
+import Text.Megaparsec.Char (eol, space1, string)
+import Text.Megaparsec.Char.Lexer qualified as L
+
+newtype Seeds = Seeds [Int]
+  deriving newtype (Show)
+
+-- | Parse a list of seeds
+--
+-- >>> parseText pSeeds "seeds: 79 14 55 13"
+-- Right [79,14,55,13]
+pSeeds :: Parser Seeds
+pSeeds = Seeds <$> (string "seeds: " *> L.decimal `sepBy1` ws)
+
+newtype Mapping = Mapping [((Int, Int), (Int, Int))]
+
+pRanges :: Parser [((Int, Int), (Int, Int))]
+pRanges = do
+  pRange `sepBy1` eol
+ where
+  pRange = do
+    x0 <- L.decimal <* space1
+    x1 <- L.decimal <* space1
+    n <- L.decimal
+    pure ((x0, x0 + n), (x1, x1 + n))
+
+pMapping :: Parser Mapping
+pMapping = do
+  _ <-
+    choice
+      [ string "soil-to-fertilizer map:"
+      , string "fertilizer-to-water map:"
+      , string "water-to-light map:"
+      , string "light-to-temperature map:"
+      , string "light-to-temperature map:"
+      ]
+      <* eol
+  Mapping . fromList <$> pRanges `sepBy1` eol
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
 solve _ = pure $ Left "not yet implemented"

test/doctest/Doctest.hs

@@ -4,7 +4,9 @@ module Main (main) where
 import System.Process (callProcess)
 
 doctest :: IO ()
-doctest = callProcess "cabal" ["repl", "--with-ghc=doctest"]
+doctest = do
+  args <- ("--ghc-option=" ++) <<$>> getArgs
+  callProcess "cabal" $ ["repl", "--with-ghc=doctest"] <> args
 
 main :: IO ()
 main = doctest

test/spec/AoCSpec/Y2023Spec.hs

@@ -20,3 +20,7 @@ spec = do
   describe "Day 4" do
     it "calculates correctly" do
       runAoC Y2023 D04 `shouldReturn` Right [24542, 8736438]
+
+  describe "Day 5" do
+    it "calculates the example correctly" do
+      runAoCExample Y2023 D05 `shouldReturn` Right [35]