Overengineered Day2

adventofcode.cabal

@@ -13,13 +13,15 @@ build-type:     Simple
 library
   exposed-modules:
       AoC.Day1
+      AoC.Day2
   other-modules:
       Paths_adventofcode
   hs-source-dirs:
       src
   ghc-options: -Wall
   build-depends:
-      base ==4.*
+      attoparsec
+    , base ==4.*
     , text
   default-language: Haskell2010
 
@@ -32,6 +34,7 @@ executable adventofcode
   ghc-options: -Wall
   build-depends:
       adventofcode
+    , attoparsec
     , base ==4.*
     , text
   default-language: Haskell2010

executable/Main.hs

@@ -1,8 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 import AoC.Day1 as Day1
+import AoC.Day2 as Day2
+
+import qualified Data.Text.IO as T (readFile)
 
 main :: IO ()
 main = do
   putStrLn "Hello World!"
-  input <- readFile "./input/day1.txt"
+  input1 <- readFile "./input/day1.txt"
-  putStrLn $ show $ Day1.solveA input
+  putStrLn $ show $ Day1.solveA input1
-  putStrLn $ show $ Day1.solveB input
+  putStrLn $ show $ Day1.solveB input1
+
+  input2 <- T.readFile "./input/day2.txt"
+  putStrLn $ show $ Day2.solveA "A Y\nB X\nC Z"
+  putStrLn $ show $ Day2.solveA input2
+  putStrLn $ show $ Day2.solveB "A Y\nB X\nC Z"
+  putStrLn $ show $ Day2.solveB input2

flake.nix

@@ -32,6 +32,7 @@
           packages = h: [h.adventofcode];
           withHoogle = true;
           buildInputs = with pkgs; [
+            haskell-language-server
             cabal-install
             entr
             ghcid
@@ -40,7 +41,7 @@
             stylish-haskell
           ];
           shellHook = ''
-            hpack
+            ${pkgs.hpack}/bin/hpack
           '';
         };
       }

package.yaml

@@ -5,11 +5,13 @@ ghc-options: -Wall
 dependencies:
   - base == 4.*
   - text
+  - attoparsec
 
 library:
   source-dirs: src
   exposed-modules:
     - AoC.Day1
+    - AoC.Day2
 
 executable:
   source-dirs: executable

src/AoC/Day1.hs

@@ -1,10 +1,13 @@
 
 module AoC.Day1 where
 
-import Data.List (groupBy,null,sort)
+import Data.List (groupBy,sort)
 
 parseInput :: String -> [[Int]]
-parseInput = map (map read) . map tail . groupBy (\l r -> (not $ null r)) . lines
+parseInput = map (map read) . map tail . groupBy (\_l r -> (not $ null r)) . lines
 
+solveA :: String -> Int
 solveA = maximum . map sum . parseInput
+
+solveB :: String -> Int
 solveB = sum . take 3 . reverse . sort . map sum . parseInput

src/AoC/Day2.hs

@@ -0,0 +1,144 @@
+module AoC.Day2 where
+
+import Control.Applicative ((<|>))
+import Data.Attoparsec.Text
+import Data.Monoid
+import Data.Text (Text)
+import qualified Data.Text as T
+
+type Game = [Turn]
+
+data Turn = Turn Move Move
+  deriving Show
+
+data Move = Rock | Paper | Scissors
+  deriving (Show, Eq, Enum)
+
+instance Ord Move where
+  Paper `compare` Rock = GT
+  Rock `compare` Paper = LT
+
+  Paper `compare` Scissors = LT
+  Scissors `compare` Paper = GT
+
+  Rock `compare` Scissors = GT
+  Scissors `compare` Rock = LT
+
+  Paper `compare` Paper = EQ
+  Rock `compare` Rock = EQ
+  Scissors `compare` Scissors = EQ
+
+toMove :: Char -> Move
+toMove 'A' = Rock
+toMove 'B' = Paper
+toMove 'C' = Scissors
+toMove 'X' = Rock
+toMove 'Y' = Paper
+toMove 'Z' = Scissors
+toMove _   = undefined
+
+parseGame :: Text -> Either String Turn
+parseGame = parseOnly parseTurn
+
+parseTurn :: Parser Turn
+parseTurn = do
+  move1 <- parseABC
+  _ <- space
+  move2 <- parseXYZ
+  pure $ Turn move1 move2
+
+parseABC :: Parser Move
+parseABC = do
+  c <- char 'A' <|> char 'B' <|> char 'C'
+  pure $ toMove c
+
+parseXYZ :: Parser Move
+parseXYZ = do
+  c <- char 'X' <|> char 'Y' <|> char 'Z'
+  pure $ toMove c
+
+parseInput :: Text -> Either String Game
+parseInput = sequenceA . fmap parseGame . T.lines
+
+moveValue :: Move -> Int
+moveValue Rock = 1
+moveValue Paper = 2
+moveValue Scissors = 3
+
+turnValue :: Turn -> Int
+turnValue (Turn a b) = case compare a b of
+  LT -> 6
+  EQ -> 3
+  GT -> 0
+
+gradeTurn :: Turn -> Int
+gradeTurn t@(Turn _ m2) = turnValue t + moveValue m2
+
+solveA :: Text -> Either String Int
+solveA input = do
+  pInput <- parseInput input
+  pure $ getSum $ mconcat $ map (Sum . gradeTurn) pInput
+
+--------------------------------------------------------------------------------
+-- Part 2
+
+type Game2 = [Turn2]
+
+data Turn2 = Turn2 Move Outcome
+  deriving Show
+
+data Outcome = Lose | Draw | Win
+  deriving Show
+
+toOutcome :: Char -> Outcome
+toOutcome 'X' = Lose
+toOutcome 'Y' = Draw
+toOutcome 'Z' = Win
+toOutcome _ = undefined
+
+outcomeValue :: Outcome -> Int
+outcomeValue Lose = 0
+outcomeValue Draw = 3
+outcomeValue Win = 6
+
+next :: Move -> Move
+next Rock = Paper
+next Paper = Scissors
+next Scissors = Rock
+
+prev :: Move -> Move
+prev Rock = Scissors
+prev Paper = Rock
+prev Scissors = Paper
+
+findMove :: Turn2 -> Move
+findMove (Turn2 m Win) = next m
+findMove (Turn2 m Draw) = m
+findMove (Turn2 m Lose) = prev m
+
+turnValue2 :: Turn2 -> Int
+turnValue2 t@(Turn2 _ o) = outcomeValue o + moveValue (findMove t)
+
+parseInput2 :: Text -> Either String Game2
+parseInput2 = sequenceA . fmap parseGame2 . T.lines
+
+parseGame2 :: Text -> Either String Turn2
+parseGame2 = parseOnly parseTurn2
+
+parseTurn2 :: Parser Turn2
+parseTurn2 = do
+  move <- parseABC
+  _ <- space
+  outcome <- parseOutcome
+  pure $ Turn2 move outcome
+
+parseOutcome :: Parser Outcome
+parseOutcome = do
+  c <- char 'X' <|> char 'Y' <|> char 'Z'
+  pure $ toOutcome c
+
+solveB :: Text -> Either String Int
+solveB input = do
+  pInput <- parseInput2 input
+  pure $ getSum $ mconcat $ map (Sum . turnValue2) pInput
+