Initial release

src/Day2.hs

@@ -0,0 +1,73 @@
+module Day2 (fun) where
+
+import ClassyPrelude
+
+data Hand = Rock | Paper | Scissors
+  deriving (Eq)
+
+parseHand :: Char -> Hand
+parseHand h | h == 'X' || h == 'A' = Rock
+            | h == 'Y' || h == 'B' = Paper
+            | otherwise = Scissors
+
+points :: Hand -> Int
+points = \case
+  Rock -> 1
+  Paper -> 2
+  Scissors -> 3
+
+data Result = Lost | Draw | Won
+  deriving (Eq)
+
+resultPoints :: Result -> Int
+resultPoints = \case
+  Lost -> 0
+  Draw -> 3
+  Won -> 6
+
+beats :: Hand -> Hand -> Bool
+beats Rock Scissors = True
+beats Paper Rock = True
+beats Scissors Paper = True
+beats _ _ = False
+
+play :: Hand -> Hand -> Result
+play a b =
+  if | a == b -> Draw
+     | beats a b -> Lost
+     | otherwise -> Won
+
+runLineProb1 :: Text -> Int
+runLineProb1 l =
+  let a = parseHand $ headEx l
+      b = parseHand $ lastEx l
+      handPoint = points b
+      gamePoint = resultPoints $ play a b
+  in handPoint + gamePoint
+
+incHand :: Hand -> Hand
+incHand Rock = Paper
+incHand Paper = Scissors
+incHand Scissors = Rock
+
+decideHand :: Char -> Hand -> Hand
+decideHand 'X' = incHand . incHand
+decideHand 'Y' = id
+decideHand 'Z' = incHand
+decideHand _ = id
+
+runLineProb2 :: Text -> Int
+runLineProb2 l =
+  let a = parseHand $ headEx l
+      b = decideHand (lastEx l) a
+      handPoint = points b
+      gamePoint = resultPoints $ play a b
+  in handPoint + gamePoint
+
+fun :: IO ()
+fun = do
+  readFileUtf8 "puzzle2.txt"
+    >>= \res -> putStrLn $ "Day2.2: " <> tshow (sum . map runLineProb1 . lines $ res)
+
+  readFileUtf8 "puzzle2.txt"
+    >>= \res -> putStrLn $ "Day2.2: " <> tshow (sum . map runLineProb2 . lines $ res)

src/Day3.hs

@@ -0,0 +1,33 @@
+module Day3 (run) where
+
+import ClassyPrelude
+
+import Data.List.Split (chunksOf)
+
+priority :: Map Char Int
+priority = mapFromList . zip (['a' .. 'z'] ++ ['A' .. 'Z']) $ [1 ..]
+
+prob1 :: Text -> Int
+prob1 dat =
+  let (a, b) = splitAt (div (length dat) 2) dat
+   in fromMaybe
+        0
+        ( flip lookup priority
+            . headEx
+            $ (setFromList (unpack a) :: Set Char) `intersect` setFromList (unpack b)
+        )
+
+prob2 :: [Text] -> Char
+prob2 [a, b, c] =
+  headEx . toList $
+    (setFromList (unpack a) :: Set Char)
+      `intersect` setFromList (unpack b)
+      `intersect` setFromList (unpack c)
+prob2 _ = ';'
+
+run :: IO ()
+run = do
+  file <- getArgs >>= readFileUtf8 . unpack . headEx
+  putStrLn $ "day3.1: " <> (tshow . sum . map prob1 . lines $ file)
+
+  putStrLn $ "day3.2: " <> (tshow . sum . mapMaybe (flip lookup priority . prob2) . chunksOf 3 . lines $ file)

src/Lib.hs

@@ -0,0 +1,76 @@
+module Lib (
+  someFunc,
+) where
+
+import ClassyPrelude hiding (decodeUtf8, (<|))
+import Control.Monad.ST
+import qualified Data.ByteString as B
+import Data.Char (ord)
+import Data.STRef
+import System.IO.Posix.MMap
+
+newtype TrieGroup = TrieGroup (Int, Int, Int)
+
+parseNumber :: ByteString -> Int
+parseNumber b = runST $ do
+  len <- newSTRef (length b - 1)
+  foldlM
+    ( \acc c -> do
+        i <- readSTRef len
+        modifySTRef' len (\v -> v - 1)
+        pure $! getNumber c * (10 ^ i) + acc
+    )
+    0
+    b
+ where
+  getNumber :: Word8 -> Int
+  getNumber c = fromIntegral $ c - (fromIntegral . ord $ '0')
+{-# INLINE parseNumber #-}
+
+insertTrieGroup ::
+  TrieGroup ->
+  Int ->
+  TrieGroup
+insertTrieGroup t@(TrieGroup (!a, !b, !c)) i
+  | i > a = TrieGroup (i, a, b)
+  | i > b = TrieGroup (a, i, b)
+  | i > c = TrieGroup (a, b, i)
+  | otherwise = t
+{-# INLINE insertTrieGroup #-}
+
+newline :: Word8
+newline = fromIntegral . ord $ '\n'
+
+
+run :: ByteString -> TrieGroup
+run bs = runST $ do
+  foundNewLine <- newSTRef False
+  (t, acc, s) <-
+    foldlM
+      ( \(t, acc, s) c -> do
+          if c == newline
+            then do
+              readSTRef foundNewLine >>= \case
+                True -> do
+                  writeSTRef foundNewLine False
+                  pure (insertTrieGroup t s, [], 0)
+                False -> do
+                  writeSTRef foundNewLine True
+                  pure (t, [], s + parseNumber (B.pack . reverse $ acc))
+            else do
+              writeSTRef foundNewLine False
+              pure (t, c : acc, s)
+
+      )
+      (TrieGroup (0, 0, 0), [], 0 :: Int)
+      bs
+
+  pure (insertTrieGroup t (s + parseNumber (B.pack . reverse $ acc)))
+
+someFunc :: IO ()
+someFunc = do
+  puzzleInput <- unsafeMMapFile "aoc_2022_day01_large_input.txt"
+  let TrieGroup (a, b, c) = run puzzleInput
+
+  putStrLn $ "Day1.1: " <> tshow a
+  putStrLn $ "Day1.2: " <> tshow (a + b + c)