Day 2

aoc2022.cabal

@@ -28,6 +28,9 @@ library
       Day1
       Day1.Internal
       Day2
+      Day2.Part1
+      Day2.Part2
+      Day2.Shared
       Lib
   other-modules:
       Paths_aoc2022

src/Day2.hs

@@ -0,0 +1,16 @@
+module Day2 (
+  day2
+) where
+
+import Day2.Part1
+import Day2.Part2
+
+day2 :: IO ()
+day2 = do
+   input <- readFile "ressources/day02-input"
+   putStrLn "Day1"
+   let score1 = day2_1 input
+   putStrLn ("Score of all games: " ++ show score1)
+   let score2 = day2_2 input
+   putStrLn ("Score of all games according to plan: " ++ show score2)
+   return ()

src/Day2/Part1.hs

@@ -0,0 +1,31 @@
+module Day2.Part1 (
+parseGameList,
+readGame,
+playGames,
+day2_1
+) where
+
+import Day2.Shared
+
+parseGameList :: String -> [Game]
+parseGameList = map readGame . lines
+
+readGame :: String -> Game
+readGame [x, ' ', y] = Game (opponent x, me y)
+  where
+    opponent 'A' = Rock
+    opponent 'B' = Paper
+    opponent 'C' = Scissors
+    opponent _ = error $ "unknown opponent shape: " ++ [x]
+    me 'X' = Rock
+    me 'Y' = Paper
+    me 'Z' = Scissors
+    me _ = error $ "unknown me shape: " ++ [x]
+readGame xs = error $ "readGame not implemented for " ++ xs
+
+playGames :: [Game] -> Score
+playGames = foldMap play
+
+day2_1 :: String -> Score
+day2_1 = playGames . parseGameList
+

src/Day2/Part2.hs

@@ -0,0 +1,42 @@
+module Day2.Part2 (
+day2_2,
+readGameHints,
+GameHint (GameHint),
+Outcome (Win, Draw, Lose),
+executePlan
+) where
+
+import Day2.Shared
+
+data Outcome = Win | Draw | Lose deriving (Show, Eq)
+
+newtype GameHint = GameHint (Shape, Outcome) deriving (Show, Eq)
+
+readGameHints :: String -> [GameHint]
+readGameHints = map parseGameHint . lines
+
+parseGameHint :: String -> GameHint
+parseGameHint [x, ' ', y] = GameHint (opponent x, me y)
+  where
+    opponent 'A' = Rock
+    opponent 'B' = Paper
+    opponent 'C' = Scissors
+    opponent _ = error $ "unknown shape: " ++ [x]
+    me 'X' = Lose
+    me 'Y' = Draw
+    me 'Z' = Win
+    me _ = error $ "unknown game result: " ++ [x]
+parseGameHint xs = error $ "readGameHint not implemented for " ++ xs
+
+playGames :: [GameHint] -> Score
+playGames = foldMap (play . executePlan)
+
+executePlan :: GameHint -> Game
+executePlan (GameHint (x, Draw)) = Game (x, x)
+executePlan (GameHint (x, Win)) = Game (x, winAgainst x)
+executePlan (GameHint (x, Lose)) = Game (x, loseAgainst x)
+
+
+day2_2 :: String -> Score
+day2_2 = playGames . readGameHints
+

src/Day2/Shared.hs

@@ -0,0 +1,58 @@
+module Day2.Shared (
+  Shape (Rock, Paper, Scissors),
+  shapeScore,
+  Score (Score),
+  Game (Game),
+  gameWin,
+  gameLoss,
+  gameDraw,
+  play,
+  winAgainst,
+  loseAgainst
+) where
+
+data Shape = Rock | Paper | Scissors
+  deriving (Show, Eq)
+
+newtype Score = Score Int
+  deriving (Show, Eq)
+
+instance Semigroup Score where
+  (<>) (Score x) (Score y) = Score (x + y)
+
+instance Monoid Score where
+  mempty = Score 0
+
+gameWin :: Score
+gameWin = Score 6
+
+gameDraw :: Score
+gameDraw = Score 3
+
+gameLoss :: Score
+gameLoss = Score 0
+
+newtype Game = Game (Shape, Shape)
+  deriving (Show, Eq)
+
+shapeScore :: Shape -> Score
+shapeScore Rock = Score 1
+shapeScore Paper = Score 2
+shapeScore Scissors = Score 3
+
+winAgainst :: Shape -> Shape
+winAgainst Rock = Paper
+winAgainst Paper = Scissors
+winAgainst Scissors = Rock
+
+loseAgainst :: Shape -> Shape
+loseAgainst Rock = Scissors
+loseAgainst Paper = Rock
+loseAgainst Scissors = Paper
+
+
+play :: Game -> Score
+play (Game (x, y))
+ | winAgainst  x == y = gameWin  <> shapeScore y
+ | loseAgainst x == y = gameLoss <> shapeScore y
+ | otherwise          = gameDraw <> shapeScore y

src/Lib.hs

@@ -2,8 +2,8 @@ module Lib
     ( someFunc
     ) where
       
-import Day1      
+import Day2      
 
 someFunc :: IO ()
-someFunc = day1
+someFunc = day2
 

test/Day2Spec.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day2Spec (spec) where
+import Test.Hspec
+import Day2.Shared
+import Day2.Part1
+import Day2.Part2
+
+input :: String 
+input = "A Y\nB X\nC Z"
+
+spec :: Spec
+spec =
+  describe "Day2" $ do
+    describe "Day2 - Shared" $ do
+      it "should have scores for shapes" $ do
+        shapeScore Rock `shouldBe` Score 1
+        shapeScore Paper `shouldBe` Score 2
+        shapeScore Scissors `shouldBe` Score 3
+      it "can sum up scores" $ do
+        Score 1 <> Score 2 `shouldBe` Score 3
+      it "can play games" $ do
+        play (Game (Rock, Paper)) `shouldBe` shapeScore Paper <> gameWin
+    describe "Day2 - Part1" $ do
+      it "can parse game plan" $ do
+         parseGameList input `shouldBe` games
+      it "can parse a single game" $ do
+        readGame "A Y" `shouldBe` Game (Rock, Paper)
+        readGame "B X" `shouldBe` Game (Paper, Rock)
+        readGame "C Z" `shouldBe` Game (Scissors, Scissors)
+      it "can sum up games" $ do
+        playGames games `shouldBe` Score 15
+      it "can play game plan" $ do
+         day2_1 input `shouldBe` Score 15
+    describe "Day2 - Part1" $ do
+      it "can parse game plan as hints" $ do
+         readGameHints input `shouldBe` gameHints
+      it "can convert game plan" $ do
+         map executePlan gameHints `shouldBe` [Game (Rock, Rock),
+          Game (Paper, Rock), Game (Scissors, Rock)]
+      it "can play a game plan" $ do
+         day2_2 input `shouldBe` Score 12
+      where
+        games = [Game (Rock, Paper), Game (Paper, Rock), Game (Scissors, Scissors)]
+        gameHints = [GameHint (Rock, Draw), GameHint (Paper, Lose), GameHint (Scissors, Win)]
+