Solve 2023-05

data/Y2023/D05/riddle

@@ -0,0 +1 @@
+/home/alex/src/aoc/data/Y2023/D05/example

src/AoC.hs

@@ -39,4 +39,4 @@ printResult (Left e) = putTextLn e
 printResult (Right s) = print s
 
 defaultMain :: IO ()
-defaultMain = Exception.catch (runAoC Y2023 D04 >>= printResult) handleError
+defaultMain = Exception.catch (runAoC Y2023 D05 >>= printResult) handleError

src/AoC/Y2023/D05.hs

@@ -2,9 +2,10 @@ module AoC.Y2023.D05 where
 
 import AoC.Parser
 import AoC.Riddle
-import Text.Megaparsec (choice, sepBy1)
+import Text.Megaparsec (choice, eof, sepBy, sepBy1, someTill, try)
+import Text.Megaparsec.Debug (dbg)
 
-import Text.Megaparsec.Char (eol, space1, string)
+import Text.Megaparsec.Char (char, eol, space1, string)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 newtype Seeds = Seeds [Int]
@@ -12,35 +13,68 @@ newtype Seeds = Seeds [Int]
 
 -- | Parse a list of seeds
 --
--- >>> parseText pSeeds "seeds: 79 14 55 13"
+-- >>> parseText pSeeds "seeds: 79 14 55 13\n"
 -- Right [79,14,55,13]
 pSeeds :: Parser Seeds
-pSeeds = Seeds <$> (string "seeds: " *> L.decimal `sepBy1` ws)
+pSeeds = Seeds <$> (string "seeds: " *> (L.decimal `sepBy1` char ' ') <* eol)
 
-newtype Mapping = Mapping [((Int, Int), (Int, Int))]
+data Mapping = Mapping
+  { name :: Text
+  , indices :: [(Int, Int, Int)]
+  }
+  deriving stock (Show)
 
-pRanges :: Parser [((Int, Int), (Int, Int))]
+pRanges :: Parser [(Int, Int, Int)]
 pRanges = do
-  pRange `sepBy1` eol
+  some pRange
  where
-  pRange = do
+  pRange = Text.Megaparsec.try $ do
     x0 <- L.decimal <* space1
     x1 <- L.decimal <* space1
-    n <- L.decimal
+    n <- L.decimal <* eol
-    pure ((x0, x0 + n), (x1, x1 + n))
+    pure (x0, x1, n)
 
+-- | Parse an index mapping
+--
+-- >>> parseText pMapping "seed-to-soil map:\n50 98 2\n52 50 48\n"
+-- Right [(50,98,2),(52,50,48)]
 pMapping :: Parser Mapping
 pMapping = do
-  _ <-
+  name <-
     choice
-      [ string "soil-to-fertilizer map:"
+      [ string "seed-to-soil"
-      , string "fertilizer-to-water map:"
+      , string "soil-to-fertilizer"
-      , string "water-to-light map:"
+      , string "fertilizer-to-water"
-      , string "light-to-temperature map:"
+      , string "water-to-light"
-      , string "light-to-temperature map:"
+      , string "light-to-temperature"
+      , string "temperature-to-humidity"
+      , string "humidity-to-location"
       ]
+      <* string " map:"
       <* eol
-  Mapping . fromList <$> pRanges `sepBy1` eol
+  Mapping name <$> pRanges
+
+data Puzzle = Puzzle
+  { seeds :: Seeds
+  , mappings :: [Mapping]
+  }
+  deriving stock (Show)
+
+pPuzzle :: Parser Puzzle
+pPuzzle =
+  Puzzle <$> (pSeeds <* ws) <*> some (pMapping <* (void eol <|> eof))
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve _ = pure $ Left "not yet implemented"
+solve riddle = case parseText (pPuzzle <* eof) riddle of
+  Right puzzle ->
+    let
+      part1 :: Integer
+      part1 = genericLength (mappings puzzle)
+
+      part2 :: Integer
+      part2 = part1
+     in
+      do
+        print puzzle
+        pure $ Right [part1, part2]
+  Left e -> pure $ Left e