Merge pull request #19 from ephemient/hs/day3

.github/workflows/hs.yml

@@ -71,6 +71,7 @@ jobs:
           path: hs
       - uses: haskell-actions/run-ormolu@v16
         with:
+          extra-args: --ghc-opt -XGHC2024
           pattern: |
             hs/**/*.hs
             hs/**/*.hs-boot

README.md

@@ -7,3 +7,4 @@ Development occurs in language-specific directories:
 |--:|--:|--:|--:|
 |[Day1.hs](hs/src/Day1.hs)|[Day1.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day1.kt)|[day1.py](py/aoc2024/day1.py)|[day1.rs](rs/src/day1.rs)|
 |[Day2.hs](hs/src/Day2.hs)|[Day2.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day2.kt)|[day2.py](py/aoc2024/day2.py)|[day2.rs](rs/src/day2.rs)|
+|[Day3.hs](hs/src/Day3.hs)||||

hs/aoc2024.cabal

@@ -23,13 +23,16 @@ library
   exposed-modules:
     Day1
     Day2
+    Day3
 
   other-modules:
     Common
 
   build-depends:
     base ^>=4.20.0.0,
     containers ^>=0.7,
+    megaparsec ^>=9.7.0,
+    parser-combinators ^>=1.3.0,
     text ^>=2.1.1,
 
   ghc-options: -Wall
@@ -43,6 +46,7 @@ executable aoc2024
     aoc2024,
     base ^>=4.20.0.0,
     filepath ^>=1.5.2.0,
+    megaparsec ^>=9.7.0,
     text ^>=2.1.1,
 
   ghc-options:

hs/app/Main.hs

@@ -9,8 +9,10 @@ import Data.Text (Text)
 import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day2 qualified (part1, part2)
+import Day3 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
+import Text.Megaparsec (errorBundlePretty)
 
 getDayInput :: Int -> IO Text
 getDayInput i = do
@@ -33,3 +35,4 @@ main :: IO ()
 main = do
   run 1 (either fail print) [Day1.part1, Day1.part2]
   run 2 (either fail print) [Day2.part1, Day2.part2]
+  run 3 (either (fail . errorBundlePretty) print) [Day3.part1, Day3.part2]

hs/bench/Main.hs

@@ -8,6 +8,7 @@ import Data.Text (Text)
 import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day2 qualified (part1, part2)
+import Day3 qualified (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -36,5 +37,11 @@ main =
           "Day 2"
           [ bench "part 1" $ nf Day2.part1 input,
             bench "part 2" $ nf Day2.part2 input
+          ],
+      env (getDayInput 3) $ \input ->
+        bgroup
+          "Day 3"
+          [ bench "part 1" $ nf Day3.part1 input,
+            bench "part 2" $ nf Day3.part2 input
           ]
     ]

hs/src/Day3.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day3
+-- Description:    <https://adventofcode.com/2024/day/3 Day 3: Mull It Over>
+module Day3 (part1, part2) where
+
+import Data.Functor (($>))
+import Data.String (IsString)
+import Data.Text (Text)
+import Data.Void (Void)
+import Text.Megaparsec (MonadParsec (try), ParseErrorBundle, Stream (Token, Tokens), anySingle, between, many, parse, skipManyTill, (<|>))
+import Text.Megaparsec.Char (char, string)
+import Text.Megaparsec.Char.Lexer qualified as L (decimal)
+
+mul :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m a
+mul = between (string "mul(") (string ")") $ (*) <$> L.decimal <* char ',' <*> L.decimal
+
+parser1 :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m [a]
+parser1 = many $ try $ skipManyTill anySingle $ try mul
+
+parser2 :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m [Either Bool a]
+parser2 = many $ try $ skipManyTill anySingle $ Right <$> try mul <|> string "do()" $> Left True <|> string "don't()" $> Left False
+
+part1 :: Text -> Either (ParseErrorBundle Text Void) Int
+part1 = fmap sum . parse parser1 ""
+
+part2 :: Text -> Either (ParseErrorBundle Text Void) Int
+part2 = fmap (snd . foldl' go (True, 0)) . parse parser2 ""
+  where
+    go (_, a) (Left z) = (z, a)
+    go (True, a) (Right b) = (True,) $! a + b
+    go k _ = k

hs/test/Day3Spec.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day3Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day3 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example1, example2 :: Text
+example1 =
+  T.unlines
+    [ "xmul(2,4)%&mul[3,7]!@^do_not_mul(5,5)+mul(32,64]then(mul(11,8)mul(8,5))"
+    ]
+example2 =
+  T.unlines
+    [ "xmul(2,4)&mul[3,7]!^don't()_mul(5,5)+mul(32,64](mul(11,8)undo()?mul(8,5))"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example1 `shouldBe` Right 161
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example2 `shouldBe` Right 48