day2

.gitignore

@@ -22,4 +22,4 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
-
+input

AoC2022.cabal

@@ -35,3 +35,16 @@ executable Day1
                     , safe
     hs-source-dirs:   day1
     default-language: Haskell2010
+
+executable Day2
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base ^>=4.14.3.0
+                    , safe
+    hs-source-dirs:   day2
+    default-language: Haskell2010

day2/Main.hs

@@ -0,0 +1,104 @@
+{-# LANGUAGE LambdaCase #-}
+module Main where
+
+import Data.List as L
+import Data.Maybe
+import Safe
+
+data InputOptions = DoHand
+                  | DoResult
+                  | Quit
+
+
+data RPS = Rock
+         | Paper
+         | Scissors
+         deriving (Show, Eq)
+
+data Result = Win
+            | Loss
+            | Draw
+            deriving (Show, Eq)
+
+getInput :: IO InputOptions
+getInput = do
+  putStrLn "Force Hand or force Result? (h/r/q)"
+  getLine >>= \case
+       "d" -> return DoHand
+       "r" -> return DoResult
+       "q" -> return Quit
+       _   -> putStrLn "not understood" >> getInput
+
+main :: IO ()
+main = getInput >>= \case
+    Quit -> putStrLn "bye!"
+    DoHand -> interact $
+          (<>"\n")
+        . show
+        . sum
+        . fmap ((\(a,b) -> case play a b of
+              Win  -> 6 + rpsScore b
+              Draw -> 3 + rpsScore b
+              Loss -> 0 + rpsScore b
+            )
+            . (\case [a,' ',b] -> (rps a,rps b); _ -> error "malformed input"))
+        . lines
+    DoResult -> interact $
+          (<>"\n")
+        . show
+        . sum
+        . fmap ((\(a,b) -> case b of
+              Win  -> 6 + rpsScore (fixResult b a)
+              Draw -> 3 + rpsScore (fixResult b a)
+              Loss -> 0 + rpsScore (fixResult b a)
+            )
+            . (\case [a,' ',b] -> (rps a,result b); _ -> error "malformed input"))
+        . lines
+
+fixResult :: Result -> RPS -> RPS
+fixResult Draw a        = a
+fixResult Win Rock      = Paper
+fixResult Win Paper     = Scissors
+fixResult Win Scissors  = Rock
+fixResult Loss Rock     = Scissors
+fixResult Loss Paper    = Rock
+fixResult Loss Scissors = Paper
+
+
+play :: RPS -> RPS -> Result
+play Scissors Rock  = Win
+play Paper Scissors = Win
+play Rock Paper     = Win
+play a b
+  | a == b          = Draw
+  | otherwise       = Loss
+
+rps :: Char -> RPS
+rps 'A' = Rock
+rps 'B' = Paper
+rps 'C' = Scissors
+rps 'X' = Rock
+rps 'Y' = Paper
+rps 'Z' = Scissors
+rps c = error $ "malformed Input: "<> show c
+
+rpsScore :: RPS -> Int
+rpsScore Rock     = 1
+rpsScore Paper    = 2
+rpsScore Scissors = 3
+
+result :: Char -> Result
+result 'X' = Loss
+result 'Y' = Draw
+result 'Z' = Win
+result c = error $ "malformed Input: "<> show c
+
+-- | Split a list into sublists delimited by the given element.
+--
+-- From: https://hackage.haskell.org/package/haskell-gi-0.26.2/docs/src/Data.GI.CodeGen.Util.html#splitOn
+splitOn :: Eq a => a -> [a] -> [[a]]
+splitOn x xs = go xs []
+    where go [] acc = [reverse acc]
+          go (y : ys) acc = if x == y
+                            then reverse acc : go ys []
+                            else go ys (y : acc)