Day 2

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