80 lines
1.9 KiB
Haskell
80 lines
1.9 KiB
Haskell
module AoC.Y2023.D05 where
|
|
|
|
import AoC.Parser
|
|
import AoC.Riddle
|
|
import Text.Megaparsec (choice, eof, sepBy, sepBy1, someTill, try)
|
|
import Text.Megaparsec.Debug (dbg)
|
|
|
|
import Text.Megaparsec.Char (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\n"
|
|
-- Right [79,14,55,13]
|
|
pSeeds :: Parser Seeds
|
|
pSeeds = Seeds <$> (string "seeds: " *> (L.decimal `sepBy1` char ' ') <* eol)
|
|
|
|
data Mapping = Mapping
|
|
{ name :: Text
|
|
, indices :: [(Int, Int, Int)]
|
|
}
|
|
deriving stock (Show)
|
|
|
|
pRanges :: Parser [(Int, Int, Int)]
|
|
pRanges = do
|
|
some pRange
|
|
where
|
|
pRange = Text.Megaparsec.try $ do
|
|
x0 <- L.decimal <* space1
|
|
x1 <- L.decimal <* space1
|
|
n <- L.decimal <* eol
|
|
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 "seed-to-soil"
|
|
, string "soil-to-fertilizer"
|
|
, string "fertilizer-to-water"
|
|
, string "water-to-light"
|
|
, string "light-to-temperature"
|
|
, string "temperature-to-humidity"
|
|
, string "humidity-to-location"
|
|
]
|
|
<* string " map:"
|
|
<* 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 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
|