Day 2

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)