Day 2

Y2022.cabal

@@ -12,17 +12,19 @@ source-repository head
     location:       https://github.com/ctsk/aoc-2022
 
 common warnings
-    ghc-options: -Wall
+    ghc-options: -Wall -O2 -ddump-simpl -ddump-to-file
 
 library
     default-language: Haskell2010
     hs-source-dirs:   src
+    ghc-options: -Wall -O2 -ddump-simpl -ddump-to-file
     exposed-modules:
         Lib
         Print
-        Days.D01
         Parse
         Util
+        Days.D01
+        Days.D02
     build-depends:
         base          ^>=4.18.0.0
       , megaparsec    ^>=9.4.0

app/Main.hs

@@ -6,8 +6,19 @@ import Lib
 import Print
 
 import qualified Days.D01 as D01
+import qualified Days.D02 as D02
+
 import System.Environment (getArgs)
 
+solutions :: [(Int, Day, FilePath)]
+solutions =
+    [ (1, D01.day, "./data/01.in")
+    , (2, D02.day, "./data/02.in")
+    ]
+
+runAll :: [(Int, Day, FilePath)] -> IO ()
+runAll = mapM_ (\(dayNum, day, path) -> run day path >>= printDR dayNum)
+
 header :: IO ()
 header = putStrLn "[ Day ]------(1)-----+------(2)----"
 
@@ -17,4 +28,5 @@ usage = putStrLn "./Main"
 main :: IO ()
 main =
     getArgs >>= \case
-        _ -> header >> run D01.day "data/01.in" >>= printDR 1
+        ["all"] -> header >> runAll solutions
+        _ -> header >> runAll [last (solutions)]

src/Days/D02.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
+module Days.D02 where
+
+import Lib
+import Parse
+
+import Data.Functor ((<&>))
+import Text.Megaparsec (oneOf)
+import Text.Megaparsec.Char (space)
+
+data Play = Rock | Paper | Scissors deriving (Enum, Eq, Ord, Show)
+data Guide = X | Y | Z deriving (Enum, Show)
+data Outcome = Loss | Draw | Win deriving (Enum, Show)
+
+type Intermediate = [(Play, Guide)]
+
+parser :: Parser Intermediate
+parser = someLines line
+  where
+    line :: Parser (Play, Guide)
+    line = (,) <$> elf <* space <*> guide
+
+    elf :: Parser Play
+    elf =
+        oneOf "ABC" <&> \case
+            'A' -> Rock
+            'B' -> Paper
+            'C' -> Scissors
+
+    guide :: Parser Guide
+    guide =
+        oneOf "XYZ" <&> \case
+            'X' -> X
+            'Y' -> Y
+            'Z' -> Z
+
+playScore :: Play -> Int
+playScore = (1 +) . fromEnum
+
+winScore :: Outcome -> Int
+winScore = (3 *) . fromEnum
+
+convert :: (Enum a, Enum b) => a -> b
+convert = toEnum . fromEnum
+
+part1 :: Intermediate -> Int
+part1 = sum . map f
+  where
+    f (elf, guide) = let us = convert guide in playScore us + winScore (outcome elf us)
+
+    outcome :: Play -> Play -> Outcome
+    outcome Rock Rock = Draw
+    outcome Rock Paper = Win
+    outcome Rock Scissors = Loss
+    outcome Paper Rock = Loss
+    outcome Paper Paper = Draw
+    outcome Paper Scissors = Win
+    outcome Scissors Rock = Win
+    outcome Scissors Paper = Loss
+    outcome Scissors Scissors = Draw
+
+part2 :: Intermediate -> Int
+part2 = sum . map f
+  where
+    f (elf, guide) = let us = convert guide in winScore us + playScore (counter us elf)
+
+    counter :: Outcome -> Play -> Play
+    counter Draw e = e
+    counter Win Rock = Paper
+    counter Win Paper = Scissors
+    counter Win Scissors = Rock
+    counter Loss Rock = Scissors
+    counter Loss Paper = Rock
+    counter Loss Scissors = Paper
+
+day :: Day
+day = parsecDay parser (definitive . part1, definitive . part2)

src/Util.hs

@@ -4,4 +4,7 @@ dupe :: a -> (a, a)
 dupe a = (a, a)
 
 both :: (a -> b) -> (a, a) -> (b, b)
-both f ~(x, y) = (f x, f y)
+both f ~(x, y) = (f x, f y)
+
+mapSnd :: (b -> c) -> (a, b) -> (a, c)
+mapSnd f (a, b) = (a, f b)