diff --git a/.gitignore b/.gitignore
index 4c9e245..d2f3e44 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
+.cache/
diff --git a/aoc2022.cabal b/aoc2022.cabal
new file mode 100644
index 0000000..0b68b1c
--- /dev/null
+++ b/aoc2022.cabal
@@ -0,0 +1,30 @@
+cabal-version:      3.0
+name:               aoc2022
+version:            0.1.0.0
+license:            ISC
+build-type:         Simple
+
+executable aoc2022
+  main-is:            Main.hs
+  hs-source-dirs:     src
+  other-modules:
+      AOC.Input
+      Day01 Day02 Day03 Day04 Day05 Day06 Day07 Day08 Day09 Day10
+      Day11 Day12 Day13 Day14 Day15 Day16 Day17 Day18 Day19 Day20
+      Day21 Day22 Day23 Day24 Day25
+  default-language:   Haskell2010
+  default-extensions: BangPatterns MultiWayIf TypeApplications
+  ghc-options:        -Wall -O2
+  build-depends:
+      array
+    , base >= 4.14 && < 5
+    , bytestring
+    , containers
+    , directory
+    , filepath
+    , http-client
+    , http-client-tls
+    , http-types
+    , mtl
+    , parsec
+    , split
diff --git a/src/AOC/Input.hs b/src/AOC/Input.hs
new file mode 100644
index 0000000..8b78ef8
--- /dev/null
+++ b/src/AOC/Input.hs
@@ -0,0 +1,67 @@
+-- | Fetch puzzle input from adventofcode.com and cache under @.cache/aoc/@.
+--
+-- Set @AOC_SESSION@ to the value of your browser session cookie (without
+-- @session=@). On a cache miss the input is downloaded; afterwards the local
+-- file is reused so nothing sensitive needs to be committed.
+module AOC.Input (getInput, getInputLines, year) where
+
+import Control.Exception (try)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS
+import Network.HTTP.Types.Header (hCookie)
+import System.Directory (createDirectoryIfMissing)
+import System.Environment (lookupEnv)
+import System.FilePath ((</>))
+import System.IO.Error (isDoesNotExistError)
+
+year :: Int
+year = 2022
+
+cacheDir :: FilePath
+cacheDir = ".cache" </> "aoc" </> show year
+
+cachePath :: Int -> FilePath
+cachePath day = cacheDir </> "day" ++ pad day ++ ".txt"
+  where
+    pad d | d < 10 = '0' : show d
+          | otherwise = show d
+
+fetchInput :: Int -> IO String
+fetchInput day = do
+  sess <- lookupEnv "AOC_SESSION"
+  case sess of
+    Nothing ->
+      fail $
+        "Missing AOC_SESSION: set it to your adventofcode.com session cookie "
+          ++ "to download input, or populate "
+          ++ cachePath day
+          ++ " manually."
+    Just session -> do
+      mgr <- newManager tlsManagerSettings
+      initReq <- parseRequest $ "https://adventofcode.com/" ++ show year ++ "/day/" ++ show day ++ "/input"
+      let req =
+            initReq
+              { requestHeaders = [(hCookie, B.pack $ "session=" ++ session)]
+              }
+      resp <- httpLbs req mgr
+      pure $ BL8.unpack $ responseBody resp
+
+getInput :: Int -> IO String
+getInput day = do
+  let cacheFile = cachePath day
+  cached <- try (readFile cacheFile) :: IO (Either IOError String)
+  case cached of
+    Right s -> pure s
+    Left e
+      | isDoesNotExistError e -> do
+          createDirectoryIfMissing True cacheDir
+          s <- fetchInput day
+          writeFile cacheFile s
+          pure s
+      | otherwise -> ioError e
+
+-- | Split on newlines (same as @lines@ on the raw input).
+getInputLines :: Int -> IO [String]
+getInputLines day = lines <$> getInput day
diff --git a/src/Day01.hs b/src/Day01.hs
new file mode 100644
index 0000000..4f7a1f9
--- /dev/null
+++ b/src/Day01.hs
@@ -0,0 +1,15 @@
+module Day01 (part1, part2) where
+
+parse :: String -> [Int]
+parse = map read . lines
+
+part1 :: String -> Int
+part1 s =
+  let xs = parse s
+   in length $ filter (uncurry (<)) $ zip xs (tail xs)
+
+part2 :: String -> Int
+part2 s =
+  let xs = parse s
+      sums = zipWith3 (\a b c -> a + b + c) xs (tail xs) (drop 2 xs)
+   in length $ filter (uncurry (<)) $ zip sums (tail sums)
diff --git a/src/Day02.hs b/src/Day02.hs
new file mode 100644
index 0000000..497404f
--- /dev/null
+++ b/src/Day02.hs
@@ -0,0 +1,70 @@
+module Day02 (part1, part2) where
+
+data Move = Rock | Paper | Scissors
+  deriving (Eq, Enum)
+
+parseLine :: String -> (Move, Char)
+parseLine [a, _, b] = (opp, b)
+  where
+    opp = case a of
+      'A' -> Rock
+      'B' -> Paper
+      'C' -> Scissors
+      _ -> error "Day02: bad opponent"
+parseLine _ = error "Day02: bad line"
+
+scoreRound :: Move -> Move -> Int
+scoreRound opp you =
+  outcome + shape
+  where
+    shape = 1 + fromEnum you
+    outcome = case (you, opp) of
+      (Rock, Scissors) -> 6
+      (Paper, Rock) -> 6
+      (Scissors, Paper) -> 6
+      (x, y) | x == y -> 3
+      _ -> 0
+
+youFromOutcome :: Move -> Char -> Move
+youFromOutcome opp desired =
+  case desired of
+    'X' -> lose
+    'Y' -> draw
+    'Z' -> win
+    _ -> error "Day02: bad outcome"
+  where
+    lose = case opp of
+      Rock -> Scissors
+      Paper -> Rock
+      Scissors -> Paper
+    draw = opp
+    win = case opp of
+      Rock -> Paper
+      Paper -> Scissors
+      Scissors -> Rock
+
+part1 :: String -> Int
+part1 =
+  sum
+    . map
+      ( \(opp, b) ->
+          let you = case b of
+                'X' -> Rock
+                'Y' -> Paper
+                'Z' -> Scissors
+                _ -> error "Day02: bad you"
+           in scoreRound opp you
+      )
+    . map parseLine
+    . lines
+
+part2 :: String -> Int
+part2 =
+  sum
+    . map
+      ( \(opp, b) ->
+          let you = youFromOutcome opp b
+           in scoreRound opp you
+      )
+    . map parseLine
+    . lines
diff --git a/src/Day03.hs b/src/Day03.hs
new file mode 100644
index 0000000..62e8018
--- /dev/null
+++ b/src/Day03.hs
@@ -0,0 +1,44 @@
+module Day03 (part1, part2) where
+
+import Data.Char (ord)
+import qualified Data.Set as Set
+
+priority :: Char -> Int
+priority c
+  | c >= 'a' && c <= 'z' = ord c - ord 'a' + 1
+  | otherwise = ord c - ord 'A' + 27
+
+splitHalf :: String -> (String, String)
+splitHalf s =
+  let n = length s `div` 2
+   in (take n s, drop n s)
+
+commonChar :: String -> String -> Char
+commonChar a b =
+  head $ Set.toList $ Set.intersection (Set.fromList a) (Set.fromList b)
+
+badge :: [String] -> Char
+badge [a, b, c] =
+  head $
+    Set.toList $
+      Set.intersection (Set.fromList a) $
+        Set.intersection (Set.fromList b) (Set.fromList c)
+badge _ = error "Day03: need 3 lines"
+
+part1 :: String -> Int
+part1 =
+  sum
+    . map (priority . uncurry commonChar . splitHalf)
+    . lines
+
+part2 :: String -> Int
+part2 =
+  sum
+    . map (priority . badge)
+    . chunksOf3
+    . lines
+
+chunksOf3 :: [a] -> [[a]]
+chunksOf3 (a : b : c : xs) = [a, b, c] : chunksOf3 xs
+chunksOf3 [] = []
+chunksOf3 _ = error "Day03: line count not multiple of 3"
diff --git a/src/Day04.hs b/src/Day04.hs
new file mode 100644
index 0000000..e8b0e72
--- /dev/null
+++ b/src/Day04.hs
@@ -0,0 +1,35 @@
+module Day04 (part1, part2) where
+
+import Data.List.Split (splitOn)
+
+parseRange :: String -> (Int, Int)
+parseRange s =
+  case splitOn "-" s of
+    [a, b] -> (read a, read b)
+    _ -> error "Day04: bad range"
+
+parseLine :: String -> ((Int, Int), (Int, Int))
+parseLine l =
+  case splitOn "," l of
+    [a, b] -> (parseRange a, parseRange b)
+    _ -> error "Day04: bad line"
+
+contains :: (Int, Int) -> (Int, Int) -> Bool
+contains (a, b) (c, d) = a <= c && d <= b
+
+overlap :: (Int, Int) -> (Int, Int) -> Bool
+overlap (a, b) (c, d) = not (b < c || d < a)
+
+part1 :: String -> Int
+part1 =
+  length
+    . filter (\(x, y) -> contains x y || contains y x)
+    . map parseLine
+    . lines
+
+part2 :: String -> Int
+part2 =
+  length
+    . filter (uncurry overlap)
+    . map parseLine
+    . lines
diff --git a/src/Day05.hs b/src/Day05.hs
new file mode 100644
index 0000000..9ce12be
--- /dev/null
+++ b/src/Day05.hs
@@ -0,0 +1,63 @@
+module Day05 (part1, part2) where
+
+type Stacks = [[Char]]
+
+parseStacks :: String -> (Stacks, String)
+parseStacks raw =
+  let ls = lines raw
+      (stackLines, rest) = break (all (`elem` " \t")) ls
+      numsLine = last stackLines
+      colCount = read @Int $ last $ words numsLine
+      body = init stackLines
+      cols =
+        [ filter (`elem` ['A' .. 'Z']) $
+            map (!! i) body
+          | i <- [1, 5 .. 4 * colCount - 3]
+        ]
+      movesPart = drop 1 rest -- skip blank
+   in (cols, unlines movesPart)
+
+parseMove :: String -> (Int, Int, Int)
+parseMove s =
+  case words s of
+    ["move", a, "from", b, "to", c] -> (read a, read b, read c)
+    _ -> error "Day05: bad move"
+
+apply9000 :: Stacks -> (Int, Int, Int) -> Stacks
+apply9000 stacks (n, from, to) =
+  let f = from - 1
+      t = to - 1
+      (chunk, rest) = splitAt n (stacks !! f)
+      newFrom = rest
+      newTo = reverse chunk ++ (stacks !! t)
+   in update2 f newFrom t newTo stacks
+
+apply9001 :: Stacks -> (Int, Int, Int) -> Stacks
+apply9001 stacks (n, from, to) =
+  let f = from - 1
+      t = to - 1
+      (chunk, rest) = splitAt n (stacks !! f)
+      newFrom = rest
+      newT = chunk ++ (stacks !! t)
+   in update2 f newFrom t newT stacks
+
+update2 :: Int -> [a] -> Int -> [a] -> [[a]] -> [[a]]
+update2 i vi j vj xs =
+  [ if | k == i -> vi
+       | k == j -> vj
+       | otherwise -> x
+    | (k, x) <- zip [0 ..] xs
+  ]
+
+run :: (Stacks -> (Int, Int, Int) -> Stacks) -> String -> String
+run f s =
+  let (stacks0, movesRaw) = parseStacks s
+      moves = map parseMove $ filter (not . null) $ lines movesRaw
+      stacks = foldl f stacks0 moves
+   in map head stacks
+
+part1 :: String -> String
+part1 = run apply9000
+
+part2 :: String -> String
+part2 = run apply9001
diff --git a/src/Day06.hs b/src/Day06.hs
new file mode 100644
index 0000000..6761239
--- /dev/null
+++ b/src/Day06.hs
@@ -0,0 +1,19 @@
+module Day06 (part1, part2) where
+
+import qualified Data.Set as Set
+
+marker :: Int -> String -> Int
+marker n s = go 0
+  where
+    go i
+      | i + n > length s = error "Day06: no marker"
+      | Set.size (Set.fromList chunk) == n = i + n
+      | otherwise = go (i + 1)
+      where
+        chunk = take n $ drop i s
+
+part1 :: String -> Int
+part1 = marker 4 . head . lines
+
+part2 :: String -> Int
+part2 = marker 14 . head . lines
diff --git a/src/Day07.hs b/src/Day07.hs
new file mode 100644
index 0000000..b906350
--- /dev/null
+++ b/src/Day07.hs
@@ -0,0 +1,64 @@
+module Day07 (part1, part2) where
+
+import Control.Monad.State
+import qualified Data.Map as Map
+
+data Cmd = CdRoot | CdUp | Cd String | Ls | File Int String | Dir String
+
+parseLine :: String -> Cmd
+parseLine s
+  | s == "$ cd /" = CdRoot
+  | s == "$ cd .." = CdUp
+  | take 5 s == "$ cd " = Cd (drop 5 s)
+  | s == "$ ls" = Ls
+  | take 4 s == "dir " = Dir (drop 4 s)
+  | otherwise =
+      case words s of
+        [sz, name] -> File (read sz) name
+        _ -> error "Day07: bad line"
+
+type FS = Map.Map [String] Int -- full file path -> size
+
+type St = ([String], FS)
+
+process :: [Cmd] -> FS
+process cmds = snd $ execState (mapM_ step cmds) ([], Map.empty)
+  where
+    step :: Cmd -> State St ()
+    step CdRoot = modify $ \(_, fs) -> ([], fs)
+    step CdUp = modify $ \(p, fs) -> (up p, fs)
+      where
+        up [] = []
+        up xs = init xs
+    step (Cd name) = modify $ \(p, fs) -> (p ++ [name], fs)
+    step Ls = pure ()
+    step (Dir _) = pure ()
+    step (File sz name) = do
+      p <- gets fst
+      let full = p ++ [name]
+      modify $ \(cur, fs) -> (cur, Map.insert full sz fs)
+
+dirSizes :: FS -> Map.Map [String] Int
+dirSizes fs =
+  Map.fromListWith (+) $
+    concat
+      [ [ (take i (init full), sz)
+          | i <- [0 .. length (init full)]
+        ]
+        | (full, sz) <- Map.toList fs
+      ]
+
+part1 :: String -> Int
+part1 s =
+  let fs = process $ map parseLine $ lines s
+      ds = dirSizes fs
+   in sum [sz | (_, sz) <- Map.toList ds, sz <= 100000]
+
+part2 :: String -> Int
+part2 s =
+  let fs = process $ map parseLine $ lines s
+      ds = dirSizes fs
+      used = Map.findWithDefault 0 [] ds
+      need = 30000000 - (70000000 - used)
+      candidates = [sz | (_, sz) <- Map.toList ds, sz >= need]
+   in minimum candidates
diff --git a/src/Day08.hs b/src/Day08.hs
new file mode 100644
index 0000000..333d98a
--- /dev/null
+++ b/src/Day08.hs
@@ -0,0 +1,58 @@
+module Day08 (part1, part2) where
+
+import Data.Array.Unboxed (UArray)
+import qualified Data.Array.Unboxed as A
+
+parse :: String -> UArray (Int, Int) Int
+parse s =
+  let ls = lines s
+      h = length ls
+      w = length (head ls)
+      g = A.listArray ((0, 0), (h - 1, w - 1)) [ read [c] | row <- ls, c <- row ]
+   in g
+
+visible :: UArray (Int, Int) Int -> Int
+visible g =
+  sum
+    [ 1
+      | i <- [0 .. h - 1],
+        j <- [0 .. w - 1],
+        let x = g A.! (i, j),
+        or
+          [ all (\(ii, jj) -> g A.! (ii, jj) < x) [(i, jj) | jj <- [0 .. j - 1]],
+            all (\(ii, jj) -> g A.! (ii, jj) < x) [(i, jj) | jj <- [j + 1 .. w - 1]],
+            all (\(ii, jj) -> g A.! (ii, jj) < x) [(ii, j) | ii <- [0 .. i - 1]],
+            all (\(ii, jj) -> g A.! (ii, jj) < x) [(ii, j) | ii <- [i + 1 .. h - 1]]
+          ]
+    ]
+  where
+    ((_, _), (hm, wm)) = A.bounds g
+    h = hm + 1
+    w = wm + 1
+
+scenic :: UArray (Int, Int) Int -> Int
+scenic g = maximum [score i j | i <- [0 .. h - 1], j <- [0 .. w - 1]]
+  where
+    ((_, _), (hm, wm)) = A.bounds g
+    h = hm + 1
+    w = wm + 1
+    get = (A.!) g
+    score i j =
+      let v = get (i, j)
+          left = count v [(i, jj) | jj <- [j - 1, j - 2 .. 0]]
+          right = count v [(i, jj) | jj <- [j + 1 .. w - 1]]
+          up = count v [(ii, j) | ii <- [i - 1, i - 2 .. 0]]
+          down = count v [(ii, j) | ii <- [i + 1 .. h - 1]]
+       in left * right * up * down
+    count v coords = go 0 coords
+      where
+        go !n [] = n
+        go !n (c : cs)
+          | get c >= v = n + 1
+          | otherwise = go (n + 1) cs
+
+part1 :: String -> Int
+part1 = visible . parse
+
+part2 :: String -> Int
+part2 = scenic . parse
diff --git a/src/Day09.hs b/src/Day09.hs
new file mode 100644
index 0000000..bdc2483
--- /dev/null
+++ b/src/Day09.hs
@@ -0,0 +1,45 @@
+module Day09 (part1, part2) where
+
+import Data.List (nub)
+
+type Pos = (Int, Int)
+
+parseDir :: String -> (Int, Int)
+parseDir "R" = (1, 0)
+parseDir "L" = (-1, 0)
+parseDir "U" = (0, 1)
+parseDir "D" = (0, -1)
+parseDir _ = error "Day09: bad dir"
+
+parseLine :: String -> [(Int, Int)]
+parseLine s =
+  case words s of
+    [d, n] -> replicate (read n) (parseDir d)
+    _ -> error "Day09: bad line"
+
+stepKnot :: Pos -> Pos -> Pos
+stepKnot (hx, hy) (tx, ty)
+  | abs (hx - tx) <= 1 && abs (hy - ty) <= 1 = (tx, ty)
+  | otherwise = (tx + signum (hx - tx), ty + signum (hy - ty))
+
+simulate :: [Pos] -> [(Int, Int)] -> [[Pos]]
+simulate start moves = scanl go start moves
+  where
+    go :: [Pos] -> (Int, Int) -> [Pos]
+    go rope (dx, dy) =
+      let (hx, hy) = head rope
+          h' = (hx + dx, hy + dy)
+          rest = scanl stepKnot h' (tail rope)
+       in h' : tail rest
+
+trail :: Int -> String -> [Pos]
+trail n s =
+  let moves = concatMap parseLine $ lines s
+      start = replicate n (0, 0)
+   in map last $ tail $ simulate start moves
+
+part1 :: String -> Int
+part1 = length . nub . trail 2
+
+part2 :: String -> Int
+part2 = length . nub . trail 10
diff --git a/src/Day10.hs b/src/Day10.hs
new file mode 100644
index 0000000..235fea1
--- /dev/null
+++ b/src/Day10.hs
@@ -0,0 +1,42 @@
+module Day10 (part1, part2) where
+
+import Data.List (intercalate)
+
+expand :: String -> [Int]
+expand = concatMap f . lines
+  where
+    f "noop" = [0]
+    f s
+      | take 4 s == "addx" = [0, read (drop 5 s)]
+      | otherwise = error "Day10: bad instr"
+
+xDuring :: [Int] -> [Int]
+xDuring deltas = scanl (+) 1 deltas
+
+signalSum :: [Int] -> Int
+signalSum xs =
+  sum
+    [ c * x
+      | (c, x) <- zip [1 ..] xs,
+        c `elem` [20, 60, 100, 140, 180, 220]
+    ]
+
+part1 :: String -> Int
+part1 = signalSum . xDuring . expand
+
+render :: [Int] -> String
+render xs =
+  intercalate "\n"
+    [ [ pixel (c - 1) x
+        | c <- [40 * r + 1 .. 40 * r + 40],
+          let x = xs !! (c - 1)
+      ]
+      | r <- [0 .. 5]
+    ]
+  where
+    pixel cycle0 xv =
+      let col = cycle0 `mod` 40
+       in if abs (col - xv) <= 1 then '#' else '.'
+
+part2 :: String -> String
+part2 = render . xDuring . expand
diff --git a/src/Day11.hs b/src/Day11.hs
new file mode 100644
index 0000000..4cf0d8b
--- /dev/null
+++ b/src/Day11.hs
@@ -0,0 +1,97 @@
+module Day11 (part1, part2) where
+
+import Control.Monad.State
+import Data.List (sort)
+
+data Monkey = Monkey
+  { items :: [Integer],
+    op :: Integer -> Integer,
+    divTest :: Integer,
+    ifTrue :: Int,
+    ifFalse :: Int,
+    inspections :: Integer
+  }
+
+splitBlocks :: [String] -> [[String]]
+splitBlocks [] = []
+splitBlocks ls =
+  case break null ls of
+    (a, _ : b) -> a : splitBlocks b
+    (a, []) -> [a | not (null a)]
+
+parseMonkeys :: String -> [Monkey]
+parseMonkeys = map parseBlock . splitBlocks . lines
+
+parseBlock :: [String] -> Monkey
+parseBlock ls =
+  let itemsLine = ls !! 1
+      opLine = ls !! 2
+      testLine = ls !! 3
+      trueLine = ls !! 4
+      falseLine = ls !! 5
+      nums s = case dropWhile (/= ':') s of
+        ':' : rest -> map read $ splitComma $ trim rest
+        _ -> error "Day11: items"
+      splitComma = map trim . splitOn ','
+      trim = dropWhile (== ' ') . reverse . dropWhile (== ' ') . reverse
+      splitOn _ [] = []
+      splitOn c s = case break (== c) s of
+        (a, _ : b) -> a : splitOn c b
+        (a, []) -> [a]
+      opFn = parseOp opLine
+      d = read $ last $ words testLine
+      t = read $ last $ words trueLine
+      f = read $ last $ words falseLine
+   in Monkey (nums itemsLine) opFn d t f 0
+
+parseOp :: String -> Integer -> Integer
+parseOp s = case words s of
+  ["Operation:", "new", "=", "old", "*", "old"] -> \x -> x * x
+  ["Operation:", "new", "=", "old", "*", n] -> (* read n)
+  ["Operation:", "new", "=", "old", "+", n] -> (+ read n)
+  _ -> error "Day11: op"
+
+updateMonkey :: Int -> Monkey -> [Monkey] -> [Monkey]
+updateMonkey j m' ms = take j ms ++ [m'] ++ drop (j + 1) ms
+
+throwRound :: Bool -> Integer -> State [Monkey] ()
+throwRound worryDiv3 modulus = do
+  n <- gets length
+  forM_ [0 .. n - 1] $ \i -> go i
+  where
+    go :: Int -> State [Monkey] ()
+    go i = do
+      ms <- get
+      let m = ms !! i
+      case items m of
+        [] -> pure ()
+        (it : rest) -> do
+          modify $ updateMonkey i $ m {items = rest, inspections = inspections m + 1}
+          let worry = op m it
+              worry'
+                | worryDiv3 = worry `div` 3
+                | otherwise = worry `mod` modulus
+              dest = if worry' `mod` divTest m == 0 then ifTrue m else ifFalse m
+          modify $ pushItem dest worry'
+          go i
+
+    pushItem :: Int -> Integer -> [Monkey] -> [Monkey]
+    pushItem j w ms =
+      let mj = ms !! j
+          mj' = mj {items = items mj ++ [w]}
+       in updateMonkey j mj' ms
+
+run :: Int -> Bool -> [Monkey] -> [Monkey]
+run rounds p ms0 =
+  let modulus = product $ map divTest ms0
+   in execState (replicateM_ rounds (throwRound p modulus)) ms0
+
+monkeyBusiness :: [Monkey] -> Integer
+monkeyBusiness ms =
+  product $ take 2 $ reverse $ sort $ map inspections ms
+
+part1 :: String -> Integer
+part1 s = monkeyBusiness $ run 20 True $ parseMonkeys s
+
+part2 :: String -> Integer
+part2 s = monkeyBusiness $ run 10000 False $ parseMonkeys s
diff --git a/src/Day12.hs b/src/Day12.hs
new file mode 100644
index 0000000..9c7c80b
--- /dev/null
+++ b/src/Day12.hs
@@ -0,0 +1,60 @@
+module Day12 (part1, part2) where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+type Grid = Map.Map (Int, Int) Char
+
+parse :: String -> ((Int, Int), (Int, Int), Grid)
+parse s =
+  let ls = lines s
+      cells = [((i, j), c) | (i, row) <- zip [0 ..] ls, (j, c) <- zip [0 ..] row]
+      g = Map.fromList cells
+      start = head [p | (p, 'S') <- cells]
+      end = head [p | (p, 'E') <- cells]
+      g' =
+        Map.insert start 'a' $
+          Map.insert end 'z' g
+   in (start, end, g')
+
+neigh :: (Int, Int) -> [(Int, Int)]
+neigh (i, j) = [(i - 1, j), (i + 1, j), (i, j - 1), (i, j + 1)]
+
+canStep :: Grid -> (Int, Int) -> (Int, Int) -> Bool
+canStep g from to =
+  case (Map.lookup from g, Map.lookup to g) of
+    (Just a, Just b) -> fromEnum b - fromEnum a <= 1
+    _ -> False
+
+bfs :: Grid -> [(Int, Int)] -> (Int, Int) -> Maybe Int
+bfs g starts goal = go (Set.fromList starts) Set.empty 0
+  where
+    go frontier seen d
+      | goal `Set.member` frontier = Just d
+      | Set.null frontier = Nothing
+      | otherwise =
+          let seen' = Set.union seen frontier
+              next =
+                Set.fromList
+                  [ n
+                    | p <- Set.toList frontier,
+                      n <- neigh p,
+                      canStep g p n,
+                      Set.notMember n seen'
+                  ]
+           in go next seen' (d + 1)
+
+part1 :: String -> Int
+part1 s =
+  let (start, end, g) = parse s
+   in case bfs g [start] end of
+        Nothing -> error "Day12: no path"
+        Just x -> x
+
+part2 :: String -> Int
+part2 s =
+  let (_, end, g) = parse s
+      starts = Map.keys $ Map.filter (== 'a') g
+   in case bfs g starts end of
+        Nothing -> error "Day12: no path"
+        Just x -> x
diff --git a/src/Day13.hs b/src/Day13.hs
new file mode 100644
index 0000000..e1c5b41
--- /dev/null
+++ b/src/Day13.hs
@@ -0,0 +1,73 @@
+module Day13 (part1, part2) where
+
+import Data.List (elemIndex, sort)
+import Text.ParserCombinators.Parsec
+
+data Packet = PInt Int | PList [Packet]
+  deriving (Eq, Show)
+
+packet :: Parser Packet
+packet = (PInt <$> read <$> many1 digit) <|> plist
+
+plist :: Parser Packet
+plist = do
+  _ <- char '['
+  xs <- packet `sepBy` char ','
+  _ <- char ']'
+  return $ PList xs
+
+parsePacket :: String -> Packet
+parsePacket s = case parse (packet <* eof) "" s of
+  Left e -> error $ show e
+  Right p -> p
+
+instance Ord Packet where
+  compare (PInt a) (PInt b) = compare a b
+  compare (PInt a) (PList bs) = compare (PList [PInt a]) (PList bs)
+  compare (PList as) (PInt b) = compare (PList as) (PList [PInt b])
+  compare (PList as) (PList bs) = cmpList as bs
+    where
+      cmpList [] [] = EQ
+      cmpList [] (_ : _) = LT
+      cmpList (_ : _) [] = GT
+      cmpList (x : xs) (y : ys) =
+        case compare x y of
+          EQ -> cmpList xs ys
+          c -> c
+
+parsePairs :: String -> [(Packet, Packet)]
+parsePairs s =
+  let blocks = splitBlocks $ lines s
+   in map parseBlock blocks
+  where
+    splitBlocks [] = []
+    splitBlocks ls =
+      case break null ls of
+        (a, _ : b) -> unlines a : splitBlocks b
+        (a, []) -> [unlines a | not (null a)]
+
+    parseBlock b =
+      case lines b of
+        [a, b'] -> (parsePacket a, parsePacket b')
+        _ -> error "Day13: pair"
+
+part1 :: String -> Int
+part1 s =
+  sum
+    [ i
+      | (i, (a, b)) <- zip [1 ..] (parsePairs s),
+        a <= b
+    ]
+
+divider :: Int -> Packet
+divider n = PList [PList [PInt n]]
+
+part2 :: String -> Int
+part2 s =
+  let packets = concat [[a, b] | (a, b) <- parsePairs s]
+      d2 = divider 2
+      d6 = divider 6
+      sorted = sort $ packets ++ [d2, d6]
+   in case (elemIndex d2 sorted, elemIndex d6 sorted) of
+        (Just i2, Just i6) -> (i2 + 1) * (i6 + 1)
+        _ -> error "Day13: divider not found"
diff --git a/src/Day14.hs b/src/Day14.hs
new file mode 100644
index 0000000..88b6480
--- /dev/null
+++ b/src/Day14.hs
@@ -0,0 +1,80 @@
+module Day14 (part1, part2) where
+
+import Data.List.Split (splitOn)
+import qualified Data.Set as Set
+
+type Pt = (Int, Int)
+
+parse :: String -> (Set.Set Pt, Int)
+parse s =
+  let segs = lines s
+      pts = concatMap parseSeg segs
+      maxY = maximum $ 0 : map snd (Set.toList $ Set.fromList pts)
+   in (Set.fromList pts, maxY)
+
+parseSeg :: String -> [Pt]
+parseSeg l =
+  let parts = map parsePt $ splitOn " -> " l
+   in concat $ zipWith line parts (tail parts)
+
+parsePt :: String -> Pt
+parsePt s =
+  case break (== ',') s of
+    (a, _ : b) -> (read a, read b)
+    _ -> error "Day14: pt"
+
+line :: Pt -> Pt -> [Pt]
+line (x1, y1) (x2, y2)
+  | x1 == x2 = [(x1, y) | y <- range y1 y2]
+  | y1 == y2 = [(x, y1) | x <- range x1 x2]
+  | otherwise = error "Day14: diagonal"
+  where
+    range a b = if a <= b then [a .. b] else [a, a - 1 .. b]
+
+dropSand :: Int -> Set.Set Pt -> Maybe Pt
+dropSand maxY rocks = go (500, 0)
+  where
+    go (x, y)
+      | y > maxY = Nothing
+      | otherwise =
+          let down = (x, y + 1)
+              dl = (x - 1, y + 1)
+              dr = (x + 1, y + 1)
+           in if not (down `Set.member` rocks)
+                then go down
+                else
+                  if not (dl `Set.member` rocks)
+                    then go dl
+                    else
+                      if not (dr `Set.member` rocks)
+                        then go dr
+                        else Just (x, y)
+
+floorPts :: Int -> Int -> Int -> Set.Set Pt
+floorPts minX maxX floorY = Set.fromList [(x, floorY) | x <- [minX .. maxX]]
+
+part1 :: String -> Int
+part1 s =
+  let (rocks, maxY) = parse s
+      loop !n !r =
+        case dropSand maxY r of
+          Nothing -> n
+          Just p -> loop (n + 1) (Set.insert p r)
+   in loop 0 rocks
+
+part2 :: String -> Int
+part2 s =
+  let (rocks0, maxY) = parse s
+      floorY = maxY + 2
+      xs = map fst $ Set.toList rocks0
+      spread = maxY + 10
+      minX = min (minimum xs - spread) (500 - spread)
+      maxX = max (maximum xs + spread) (500 + spread)
+      rocks = rocks0 `Set.union` floorPts minX maxX floorY
+      loop !n !r =
+        case dropSand maxBound r of
+          Nothing -> error "Day14: abyss with floor"
+          Just p ->
+            let r' = Set.insert p r
+             in if p == (500, 0) then n + 1 else loop (n + 1) r'
+   in loop 0 rocks
diff --git a/src/Day15.hs b/src/Day15.hs
new file mode 100644
index 0000000..ba7edd8
--- /dev/null
+++ b/src/Day15.hs
@@ -0,0 +1,90 @@
+module Day15 (part1, part2) where
+
+import Data.List (nub, sort)
+import Data.List.Split (splitOn)
+
+type Pt = (Int, Int)
+
+readCoord :: String -> Int
+readCoord t = read $ last $ splitOn "=" t
+
+parseCoordPair :: String -> Pt
+parseCoordPair s =
+  case splitOn ", " s of
+    [a, b] -> (readCoord a, readCoord b)
+    _ -> error "Day15: coord pair"
+
+parseLine :: String -> (Pt, Pt, Int)
+parseLine s =
+  case splitOn ": closest beacon is at " s of
+    [left, right] ->
+      let sensStr = drop (length "Sensor at ") left
+          sens = parseCoordPair sensStr
+          beac = parseCoordPair right
+          d = manhattan sens beac
+       in (sens, beac, d)
+    _ -> error "Day15: line"
+
+manhattan :: Pt -> Pt -> Int
+manhattan (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
+
+intervalRow :: Int -> Pt -> Int -> Maybe (Int, Int)
+intervalRow y (sx, sy) d =
+  let dy = abs (y - sy)
+      r = d - dy
+   in if r < 0 then Nothing else Just (sx - r, sx + r)
+
+mergeIntervals :: [(Int, Int)] -> [(Int, Int)]
+mergeIntervals [] = []
+mergeIntervals (x : xs) = go x xs
+  where
+    go (a, b) [] = [(a, b)]
+    go (a, b) ((c, d) : rest)
+      | c <= b + 1 = go (a, max b d) rest
+      | otherwise = (a, b) : go (c, d) rest
+
+rowY :: Int
+rowY = 2000000
+
+part1 :: String -> Int
+part1 s =
+  let pairs = map parseLine $ lines s
+      intervals =
+        mergeIntervals $
+          sort
+            [ i
+              | (sens, _, d) <- pairs,
+                Just i <- [intervalRow rowY sens d]
+            ]
+      covered = sum [b - a + 1 | (a, b) <- intervals]
+      beaconsOnRow = length $ nub [bx | (_, (bx, by), _) <- pairs, by == rowY]
+   in covered - beaconsOnRow
+
+part2 :: String -> Int
+part2 s =
+  let pairs = map parseLine $ lines s
+      limit = 4000000
+      intervalsFor y =
+        mergeIntervals $
+          sort $
+            [ (max 0 a, min limit b)
+              | (sens, _, d) <- pairs,
+                Just (a, b) <- [intervalRow y sens d],
+                b >= 0,
+                a <= limit
+            ]
+      findGap [] = Nothing
+      findGap [(a, b)]
+        | a > 0 = Just 0
+        | b < limit = Just (b + 1)
+        | otherwise = Nothing
+      findGap ((_a1, b1) : (a2, b2) : rest)
+        | b1 + 1 < a2 = Just (b1 + 1)
+        | otherwise = findGap ((a2, b2) : rest)
+      findY y
+        | y > limit = error "Day15: no distress"
+        | otherwise =
+            case findGap (intervalsFor y) of
+              Just x -> x * 4000000 + y
+              Nothing -> findY (y + 1)
+   in findY 0
diff --git a/src/Day16.hs b/src/Day16.hs
new file mode 100644
index 0000000..db872f5
--- /dev/null
+++ b/src/Day16.hs
@@ -0,0 +1,116 @@
+module Day16 (part1, part2) where
+
+import Data.Bits
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+type Valve = String
+
+data VInfo = VInfo Int [String]
+
+parseLine :: String -> (Valve, VInfo)
+parseLine s =
+  case words s of
+    ("Valve" : name : "has" : "flow" : "rate=" : r : _ : _ : _ : _ : ts) ->
+      let r' = read $ takeWhile (`elem` ('-' : ['0' .. '9'])) r
+          targets = splitTargets (unwords ts)
+       in (name, VInfo r' targets)
+    _ -> error "Day16: line"
+
+splitTargets :: String -> [String]
+splitTargets = map (filter (`elem` ['A' .. 'Z'])) . splitOnComma
+
+splitOnComma :: String -> [String]
+splitOnComma [] = []
+splitOnComma s =
+  case break (== ',') s of
+    (a, _ : b) -> trim a : splitOnComma b
+    (a, []) -> [trim a]
+  where
+    trim = reverse . dropWhile (== ' ') . reverse . dropWhile (== ' ')
+
+bfsDist :: Map.Map Valve VInfo -> Valve -> Map.Map Valve Int
+bfsDist g start = go (Set.singleton start) (Map.singleton start 0) [start]
+  where
+    go _seen dist [] = dist
+    go seen dist (x : xs) =
+      let d = dist Map.! x
+          nbrs = case g Map.! x of VInfo _ ns -> ns
+          foldNbr (sv, dv, q) n =
+            if Set.member n sv
+              then (sv, dv, q)
+              else (Set.insert n sv, Map.insert n (d + 1) dv, q ++ [n])
+          (seen', dist', extra) = foldl foldNbr (seen, dist, []) nbrs
+       in go seen' dist' (xs ++ extra)
+
+allDists :: Map.Map Valve VInfo -> Map.Map (Valve, Valve) Int
+allDists g =
+  Map.fromList
+    [ ((a, b), d)
+      | a <- Map.keys g,
+        (b, d) <- Map.toList $ bfsDist g a
+    ]
+
+interesting :: Map.Map Valve VInfo -> [(Valve, Int)]
+interesting g = [(n, r) | (n, VInfo r _) <- Map.toList g, r > 0]
+
+type Memo = Map.Map (Valve, Int, Int) Int
+
+dfs :: Map.Map Valve VInfo -> Map.Map (Valve, Valve) Int -> [Valve] -> [Int] -> Memo -> Valve -> Int -> Int -> (Int, Memo)
+dfs g dists names rates memo0 pos t mask
+  | t <= 0 = (0, memo0)
+  | otherwise =
+      let key = (pos, t, mask)
+       in case Map.lookup key memo0 of
+            Just v -> (v, memo0)
+            Nothing ->
+              let n = length names
+                  tryOpen (!best, !m) i
+                    | mask .&. bit i /= 0 = (best, m)
+                    | otherwise =
+                        let v = names !! i
+                            d = Map.findWithDefault 999 (pos, v) dists
+                            t' = t - d - 1
+                         in if t' <= 0
+                              then (best, m)
+                              else
+                                let gain = (rates !! i) * t'
+                                    (sub, m') = dfs g dists names rates m v t' (mask .|. bit i)
+                                    cand = gain + sub
+                                 in (max best cand, m')
+                  (best1, m1) = foldl tryOpen (0, memo0) [0 .. n - 1]
+                  result = best1
+                  m2 = Map.insert key result m1
+               in (result, m2)
+
+maxPressure :: Int -> Map.Map Valve VInfo -> Int
+maxPressure maxT g =
+  let ints = interesting g
+      names = map fst ints
+      rates = map snd ints
+      dists = allDists g
+      (v, _) = dfs g dists names rates Map.empty "AA" maxT 0
+   in v
+
+part1 :: String -> Int
+part1 s =
+  let g = Map.fromList $ map parseLine $ lines s
+   in maxPressure 30 g
+
+-- Part 2: two disjoint tours; enumerate subset for elephant using cached single-agent values
+part2 :: String -> Int
+part2 s =
+  let g = Map.fromList $ map parseLine $ lines s
+      ints = interesting g
+      names = map fst ints
+      rates = map snd ints
+      dists = allDists g
+      n = length names
+      fullMask = (1 `shiftL` n) - 1
+      run mask =
+        fst $ dfs g dists names rates Map.empty "AA" 26 mask
+      table = Map.fromList [(m, run m) | m <- [0 .. fullMask]]
+      combine m1 =
+        let m2 = fullMask `xor` m1
+         in Map.findWithDefault 0 m1 table + Map.findWithDefault 0 m2 table
+   in maximum $ map combine [0 .. fullMask]
diff --git a/src/Day17.hs b/src/Day17.hs
new file mode 100644
index 0000000..807b8f2
--- /dev/null
+++ b/src/Day17.hs
@@ -0,0 +1,113 @@
+module Day17 (part1, part2) where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+type Pt = (Int, Int)
+
+shapes :: [[Pt]]
+shapes =
+  [ [(0, 0), (1, 0), (2, 0), (3, 0)],
+    [(1, 0), (0, 1), (1, 1), (2, 1), (1, 2)],
+    [(0, 0), (1, 0), (2, 0), (2, 1), (2, 2)],
+    [(0, 0), (0, 1), (0, 2), (0, 3)],
+    [(0, 0), (1, 0), (0, 1), (1, 1)]
+  ]
+
+width :: Int
+width = 7
+
+tryMove :: Set.Set Pt -> [Pt] -> Int -> Int -> Maybe [Pt]
+tryMove occ shape dx dy =
+  let moved = [(x + dx, y + dy) | (x, y) <- shape]
+   in if all (\(x, y) -> x >= 0 && x < width && y >= 0 && not ((x, y) `Set.member` occ)) moved
+        then Just moved
+        else Nothing
+
+fallRock :: String -> Int -> Set.Set Pt -> [Pt] -> (Set.Set Pt, Int)
+fallRock jets ji occ shapePos = go ji shapePos
+  where
+    jl = length jets
+    go ji' pos =
+      let j = if jets !! (ji' `mod` jl) == '<' then -1 else 1
+          ji'' = ji' + 1
+          afterPush = case tryMove occ pos j 0 of
+            Nothing -> pos
+            Just p -> p
+       in case tryMove occ afterPush 0 (-1) of
+            Nothing -> (Set.union occ $ Set.fromList afterPush, ji'')
+            Just p -> go ji'' p
+
+towerHeight :: Set.Set Pt -> Int
+towerHeight occ
+  | Set.null occ = 0
+  | otherwise = maximum (map snd $ Set.toList occ) + 1
+
+colHeights :: Set.Set Pt -> [Int]
+colHeights occ =
+  [ if null ys then 0 else maximum ys
+    | x <- [0 .. width - 1],
+      let ys = [y | (x', y) <- Set.toList occ, x' == x]
+  ]
+
+normProfile :: Set.Set Pt -> [Int]
+normProfile occ
+  | Set.null occ = replicate width 0
+  | otherwise =
+      let hs = colHeights occ
+          m = minimum hs
+       in map (\h -> h - m) hs
+
+simulateStep :: String -> Int -> Set.Set Pt -> Int -> (Set.Set Pt, Int)
+simulateStep jets ji occ ri =
+  let shape = shapes !! ri
+      maxY = if Set.null occ then -1 else maximum (map snd $ Set.toList occ)
+      baseY = maxY + 4
+      start = [(x + 2, y + baseY) | (x, y) <- shape]
+   in fallRock jets ji occ start
+
+part1 :: String -> Int
+part1 s =
+  let jets = filter (`elem` "<>") $ concat $ lines s
+      go :: Int -> Int -> Set.Set Pt -> Int -> Int
+      go !i !ji !occ !ri
+        | i >= 2022 = towerHeight occ
+        | otherwise =
+            let (occ', ji') = simulateStep jets ji occ ri
+             in go (i + 1) ji' occ' ((ri + 1) `mod` 5)
+   in go 0 0 Set.empty 0
+
+part2 :: String -> Int
+part2 s =
+  let jets = filter (`elem` "<>") $ concat $ lines s
+      target = 1000000000000
+      (i0, h0, clen, dh) = findCycle jets
+      cycles = (target - i0) `div` clen
+      remRocks = (target - i0) `mod` clen
+      hRem = heightAfterN jets (i0 + remRocks) - h0
+   in h0 + cycles * dh + hRem
+
+heightAfterN :: String -> Int -> Int
+heightAfterN jets n = go 0 0 Set.empty 0
+  where
+    go :: Int -> Int -> Set.Set Pt -> Int -> Int
+    go !i !ji !occ !ri
+      | i >= n = towerHeight occ
+      | otherwise =
+          let (occ', ji') = simulateStep jets ji occ ri
+           in go (i + 1) ji' occ' ((ri + 1) `mod` 5)
+
+findCycle :: String -> (Int, Int, Int, Int)
+findCycle jets = go 0 0 Set.empty 0 Map.empty
+  where
+    go !i !ji !occ !ri !seen =
+      let key = (ji `mod` length jets, ri, normProfile occ)
+       in case Map.lookup key seen of
+            Just (i0, h0) ->
+              let h = towerHeight occ
+               in (i0, h0, i - i0, h - h0)
+            Nothing ->
+              let h = towerHeight occ
+                  seen' = Map.insert key (i, h) seen
+                  (occ', ji') = simulateStep jets ji occ ri
+               in go (i + 1) ji' occ' ((ri + 1) `mod` 5) seen'
diff --git a/src/Day18.hs b/src/Day18.hs
new file mode 100644
index 0000000..0eefc5a
--- /dev/null
+++ b/src/Day18.hs
@@ -0,0 +1,79 @@
+module Day18 (part1, part2) where
+
+import qualified Data.Set as Set
+
+type Pt = (Int, Int, Int)
+
+parse :: String -> Set.Set Pt
+parse = Set.fromList . map parseLine . lines
+
+parseLine :: String -> Pt
+parseLine s =
+  case break (== ',') s of
+    (a, ',' : rest) ->
+      case break (== ',') rest of
+        (b, ',' : c) -> (read a, read b, read c)
+        _ -> error "Day18: line"
+    _ -> error "Day18: line"
+
+neighbors :: Pt -> [Pt]
+neighbors (x, y, z) =
+  [ (x + 1, y, z),
+    (x - 1, y, z),
+    (x, y + 1, z),
+    (x, y - 1, z),
+    (x, y, z + 1),
+    (x, y, z - 1)
+  ]
+
+exposedFaces :: Set.Set Pt -> Int
+exposedFaces s =
+  sum
+    [ 1
+      | p <- Set.toList s,
+        n <- neighbors p,
+        not (n `Set.member` s)
+    ]
+
+floodExterior :: Set.Set Pt -> Set.Set Pt
+floodExterior cubes =
+  let xs = map (\(x, _, _) -> x) $ Set.toList cubes
+      ys = map (\(_, y, _) -> y) $ Set.toList cubes
+      zs = map (\(_, _, z) -> z) $ Set.toList cubes
+      minX = minimum xs - 1
+      maxX = maximum xs + 1
+      minY = minimum ys - 1
+      maxY = maximum ys + 1
+      minZ = minimum zs - 1
+      maxZ = maximum zs + 1
+      start = (minX, minY, minZ)
+      inRange (x, y, z) =
+        x >= minX && x <= maxX && y >= minY && y <= maxY && z >= minZ && z <= maxZ
+      go seen [] = seen
+      go seen (p : ps)
+        | p `Set.member` seen = go seen ps
+        | p `Set.member` cubes = go seen ps
+        | not (inRange p) = go seen ps
+        | otherwise =
+            let seen' = Set.insert p seen
+                nbrs = filter inRange $ neighbors p
+             in go seen' (nbrs ++ ps)
+   in go Set.empty [start]
+
+surfaceTouchingExterior :: Set.Set Pt -> Set.Set Pt -> Int
+surfaceTouchingExterior cubes exterior =
+  sum
+    [ 1
+      | p <- Set.toList cubes,
+        n <- neighbors p,
+        n `Set.member` exterior
+    ]
+
+part1 :: String -> Int
+part1 = exposedFaces . parse
+
+part2 :: String -> Int
+part2 s =
+  let cubes = parse s
+      exterior = floodExterior cubes
+   in surfaceTouchingExterior cubes exterior
diff --git a/src/Day19.hs b/src/Day19.hs
new file mode 100644
index 0000000..5f5b95b
--- /dev/null
+++ b/src/Day19.hs
@@ -0,0 +1,76 @@
+module Day19 (part1, part2) where
+
+import Control.Monad.State
+import qualified Data.Map as Map
+data Blueprint = BP
+  { bpId :: Int,
+    oreOre :: Int,
+    clayOre :: Int,
+    obsOre :: Int,
+    obsClay :: Int,
+    geoOre :: Int,
+    geoObs :: Int
+  }
+
+parseBlueprint :: String -> Blueprint
+parseBlueprint s =
+  let ws = words $ filter (`notElem` ":") s
+      nums = map read $ filter (all (`elem` ('-' : ['0' .. '9']))) ws
+   in case nums of
+        [i, a, b, c, d, e, f] -> BP i a b c d e f
+        _ -> error "Day19: blueprint"
+
+maxOreRobots :: Blueprint -> Int
+maxOreRobots bp = maximum [oreOre bp, clayOre bp, obsOre bp, geoOre bp]
+
+type Memo = Map.Map (Int, Int, Int, Int, Int, Int, Int, Int) Int
+
+runBP :: Int -> Blueprint -> Int
+runBP maxT bp = evalState (go maxT 0 0 0 1 0 0 0) Map.empty
+  where
+    mo = maxOreRobots bp
+    maxClayR = obsClay bp
+    maxObsR = geoObs bp
+    go :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> State Memo Int
+    go !t !o !c !ob !r1 !r2 !r3 !r4
+      | t == 0 = pure 0
+      | otherwise = do
+          memo <- get
+          let key = (t, o, c, ob, r1, r2, r3, r4)
+          case Map.lookup key memo of
+            Just v -> pure v
+            Nothing -> do
+              let o1 = o + r1
+                  c1 = c + r2
+                  ob1 = ob + r3
+                  this = r4
+              w <- go (t - 1) o1 c1 ob1 r1 r2 r3 r4
+              g <-
+                if o1 >= geoOre bp && ob1 >= geoObs bp
+                  then go (t - 1) (o1 - geoOre bp) c1 (ob1 - geoObs bp) r1 r2 r3 (r4 + 1)
+                  else pure 0
+              obR <-
+                if r3 < maxObsR && o1 >= obsOre bp && c1 >= obsClay bp
+                  then go (t - 1) (o1 - obsOre bp) (c1 - obsClay bp) ob1 r1 r2 (r3 + 1) r4
+                  else pure 0
+              cl <-
+                if r2 < maxClayR && o1 >= clayOre bp
+                  then go (t - 1) (o1 - clayOre bp) c1 ob1 r1 (r2 + 1) r3 r4
+                  else pure 0
+              orR <-
+                if r1 < mo && o1 >= oreOre bp
+                  then go (t - 1) (o1 - oreOre bp) c1 ob1 (r1 + 1) r2 r3 r4
+                  else pure 0
+              let ans = this + maximum [w, g, obR, cl, orR]
+              modify $ Map.insert key ans
+              pure ans
+
+part1 :: String -> Int
+part1 s =
+  let bps = map parseBlueprint $ lines s
+   in sum $ map (\bp -> bpId bp * runBP 24 bp) bps
+
+part2 :: String -> Int
+part2 s =
+  let bps = take 3 $ map parseBlueprint $ lines s
+   in product $ map (runBP 32) bps
diff --git a/src/Day20.hs b/src/Day20.hs
new file mode 100644
index 0000000..dc6c6bb
--- /dev/null
+++ b/src/Day20.hs
@@ -0,0 +1,52 @@
+module Day20 (part1, part2) where
+
+import Data.List (delete, elemIndex)
+import Data.Maybe (fromJust)
+
+parse :: String -> [Integer]
+parse = map read . lines
+
+key :: Integer
+key = 811589153
+
+tagged :: [Integer] -> [(Int, Integer)]
+tagged xs = zip [0 ..] xs
+
+moveOne :: [(Int, Integer)] -> Int -> [(Int, Integer)]
+moveOne xs k =
+  let elt@(_, v) = head $ filter ((== k) . fst) xs
+      pos = fromJust $ elemIndex elt xs
+      xs' = delete elt xs
+      len = length xs'
+      offset =
+        if len == 0
+          then 0
+          else fromInteger ((v `mod` fromIntegral len + fromIntegral len) `mod` fromIntegral len)
+      npos = (pos + offset) `mod` len
+      (a, b) = splitAt npos xs'
+   in a ++ [elt] ++ b
+
+mixOnce :: [(Int, Integer)] -> [(Int, Integer)]
+mixOnce xs = foldl moveOne xs [0 .. length xs - 1]
+
+coordinates :: [(Int, Integer)] -> Integer
+coordinates mixed =
+  let vals = map snd mixed
+      n = length vals
+      i0 = fromJust $ elemIndex 0 vals
+      a = vals !! ((i0 + 1000) `mod` n)
+      b = vals !! ((i0 + 2000) `mod` n)
+      c = vals !! ((i0 + 3000) `mod` n)
+   in a + b + c
+
+run :: Integer -> Int -> [Integer] -> Integer
+run mult rounds nums =
+  let xs = tagged $ map (* mult) nums
+      mixed = iterate mixOnce xs !! rounds
+   in coordinates mixed
+
+part1 :: String -> Integer
+part1 = run 1 1 . parse
+
+part2 :: String -> Integer
+part2 = run key 10 . parse
diff --git a/src/Day21.hs b/src/Day21.hs
new file mode 100644
index 0000000..3cd4775
--- /dev/null
+++ b/src/Day21.hs
@@ -0,0 +1,95 @@
+module Day21 (part1, part2) where
+
+import Control.Monad.State
+import qualified Data.Map as Map
+
+parse :: String -> (Int, Int)
+parse s =
+  case lines s of
+    [a, b] -> (read $ last $ words a, read $ last $ words b)
+    _ -> error "Day21: parse"
+
+move :: Int -> Int -> Int
+move p steps = ((p - 1 + steps) `mod` 10) + 1
+
+roll3 :: Int -> (Int, Int)
+roll3 d =
+  let r1 = ((d - 1) `mod` 100) + 1
+      r2 = (d `mod` 100) + 1
+      r3 = ((d + 1) `mod` 100) + 1
+   in (r1 + r2 + r3, d + 3)
+
+part1 :: String -> Int
+part1 s =
+  let (p1, p2) = parse s
+      loop !p1' !p2' !s1 !s2 !d !rolls
+        | s1 >= 1000 = s2 * rolls
+        | s2 >= 1000 = s1 * rolls
+        | otherwise =
+            let (mv, d') = roll3 d
+                np1 = move p1' mv
+                ns1 = s1 + np1
+                rolls' = rolls + 3
+             in if ns1 >= 1000
+                  then s2 * rolls'
+                  else
+                    let (mv2, d'') = roll3 d'
+                        np2 = move p2' mv2
+                        ns2 = s2 + np2
+                        rolls'' = rolls' + 3
+                     in if ns2 >= 1000
+                          then s1 * rolls''
+                          else loop np1 np2 ns1 ns2 d'' rolls''
+   in loop p1 p2 0 0 1 0
+
+dirac :: [(Int, Integer)]
+dirac =
+  Map.toList $
+    Map.fromListWith (+) $
+      [ (a + b + c, 1)
+        | a <- [1 .. 3],
+          b <- [1 .. 3],
+          c <- [1 .. 3]
+      ]
+
+type Key = (Int, Int, Int, Int, Bool)
+
+type MemoM = State (Map.Map Key (Integer, Integer))
+
+wins :: Key -> MemoM (Integer, Integer)
+wins k@(p1, p2, s1, s2, p1turn)
+  | s1 >= 21 = pure (1, 0)
+  | s2 >= 21 = pure (0, 1)
+  | otherwise = do
+      memo <- get
+      case Map.lookup k memo of
+        Just v -> pure v
+        Nothing -> do
+          let branch (mv, cnt) =
+                if p1turn
+                  then
+                    let np = move p1 mv
+                        ns = s1 + np
+                     in if ns >= 21
+                          then pure (cnt, 0)
+                          else
+                            wins (np, p2, ns, s2, False) >>= \(wp1, wp2) ->
+                              pure (cnt * wp1, cnt * wp2)
+                  else
+                    let np = move p2 mv
+                        ns = s2 + np
+                     in if ns >= 21
+                          then pure (0, cnt)
+                          else
+                            wins (p1, np, s1, ns, True) >>= \(wp1, wp2) ->
+                              pure (cnt * wp1, cnt * wp2)
+          pairs <- mapM branch dirac
+          let (wa, wb) = foldr (\(a, b) (x, y) -> (a + x, b + y)) (0, 0) pairs
+          modify $ Map.insert k (wa, wb)
+          pure (wa, wb)
+
+part2 :: String -> Integer
+part2 s =
+  let (p1, p2) = parse s
+      (a, b) = evalState (wins (p1, p2, 0, 0, True)) Map.empty
+   in max a b
diff --git a/src/Day22.hs b/src/Day22.hs
new file mode 100644
index 0000000..9514e30
--- /dev/null
+++ b/src/Day22.hs
@@ -0,0 +1,126 @@
+module Day22 (part1, part2) where
+
+import Data.Array.Unboxed (UArray, (!), bounds)
+import qualified Data.Array.Unboxed as A
+
+type Grid = UArray (Int, Int) Char
+
+parse :: String -> (Grid, String)
+parse raw =
+  let ls = lines raw
+      (gridLines, rest) = break (== "") ls
+      moves = filter (`elem` "0123456789LR") $ concat $ drop 1 rest
+      h = length gridLines
+      w = maximum $ map length gridLines
+      pad r = r ++ replicate (w - length r) ' '
+      rows = map pad gridLines
+      g = A.listArray ((0, 0), (h - 1, w - 1)) [c | row <- rows, c <- row]
+   in (g, moves)
+
+-- Match AoC: 0=right, 1=down, 2=left, 3=up
+delta :: Int -> (Int, Int)
+delta 0 = (0, 1)
+delta 1 = (1, 0)
+delta 2 = (0, -1)
+delta 3 = (-1, 0)
+delta _ = error "Day22: dir"
+
+password :: Int -> Int -> Int -> Int
+password r c d = 1000 * (r + 1) + 4 * (c + 1) + d
+
+startCol :: Grid -> Int
+startCol g =
+  let (_, (_, w)) = bounds g
+   in head [c | c <- [0 .. w], g ! (0, c) == '.']
+
+wrapFlat :: Grid -> Int -> Int -> Int -> (Int, Int)
+wrapFlat g r c d =
+  let (_, (h, w)) = bounds g
+   in case d of
+        0 -> (r, minimum [j | j <- [0 .. w], g ! (r, j) /= ' '])
+        2 -> (r, maximum [j | j <- [0 .. w], g ! (r, j) /= ' '])
+        1 -> (minimum [i | i <- [0 .. h], g ! (i, c) /= ' '], c)
+        3 -> (maximum [i | i <- [0 .. h], g ! (i, c) /= ' '], c)
+        _ -> error "Day22: wrapFlat"
+
+-- Rust reference uses dir 0=left,1=down,2=right,3=up for the folding table.
+toRust :: Int -> Int
+toRust d = (d + 3) `mod` 4
+
+fromRust :: Int -> Int
+fromRust rd = (rd + 1) `mod` 4
+
+wrapCube :: Int -> Int -> Int -> (Int, Int, Int)
+wrapCube r c d =
+  let rd = toRust d
+      qr = r `div` 50
+      qc = c `div` 50
+      dr = r `mod` 50
+      dc = c `mod` 50
+      i = [dc, dr, 49 - dc, 49 - dr] !! rd
+      (qr', qc', ndRust) = case (qr, qc, rd) of
+        (0, 1, 0) -> (3, 0, 1)
+        (0, 1, 3) -> (2, 0, 1)
+        (0, 2, 0) -> (3, 0, 0)
+        (0, 2, 1) -> (2, 1, 3)
+        (0, 2, 2) -> (1, 1, 3)
+        (1, 1, 1) -> (0, 2, 0)
+        (1, 1, 3) -> (2, 0, 2)
+        (2, 0, 0) -> (1, 1, 1)
+        (2, 0, 3) -> (0, 1, 1)
+        (2, 1, 1) -> (0, 2, 3)
+        (2, 1, 2) -> (3, 0, 3)
+        (3, 0, 1) -> (2, 1, 0)
+        (3, 0, 2) -> (0, 2, 2)
+        (3, 0, 3) -> (0, 1, 2)
+        _ -> error $ "Day22: bad cube wrap " ++ show (qr, qc, rd)
+      (nr, nc) = case ndRust of
+        0 -> (49, i)
+        1 -> (i, 0)
+        2 -> (0, 49 - i)
+        3 -> (49 - i, 49)
+        _ -> error "Day22: nd"
+      nd = fromRust ndRust
+   in (qr' * 50 + nr, qc' * 50 + nc, nd)
+
+step :: Bool -> Grid -> Int -> Int -> Int -> (Int, Int, Int)
+step cube g r c d =
+  let (dr, dc) = delta d
+      (_, (h, w)) = bounds g
+      nr = r + dr
+      nc = c + dc
+   in if nr >= 0 && nr <= h && nc >= 0 && nc <= w && g ! (nr, nc) /= ' '
+        then (nr, nc, d)
+        else
+          if cube
+            then wrapCube r c d
+            else
+              let (wr, wc) = wrapFlat g r c d
+               in (wr, wc, d)
+
+walk :: Bool -> Grid -> String -> Int
+walk cube g moves = exec (0, startCol g, 0) moves
+  where
+    exec :: (Int, Int, Int) -> String -> Int
+    exec (r, c, d) [] = password r c d
+    exec (r, c, d) ('L' : ms) = exec (r, c, (d + 3) `mod` 4) ms
+    exec (r, c, d) ('R' : ms) = exec (r, c, (d + 1) `mod` 4) ms
+    exec pos (x : ms)
+      | x `elem` ['0' .. '9'] =
+          let (nStr, rest) = span (`elem` ['0' .. '9']) (x : ms)
+              n = read nStr :: Int
+           in walkN n pos rest
+      | otherwise = exec pos ms
+    walkN :: Int -> (Int, Int, Int) -> String -> Int
+    walkN 0 pos rest = exec pos rest
+    walkN k (r, c, d) rest =
+      let (nr, nc, nd) = step cube g r c d
+       in if g ! (nr, nc) == '#'
+            then exec (r, c, d) rest
+            else walkN (k - 1) (nr, nc, nd) rest
+
+part1 :: String -> Int
+part1 s = let (g, moves) = parse s in walk False g moves
+
+part2 :: String -> Int
+part2 s = let (g, moves) = parse s in walk True g moves
diff --git a/src/Day23.hs b/src/Day23.hs
new file mode 100644
index 0000000..3159bc3
--- /dev/null
+++ b/src/Day23.hs
@@ -0,0 +1,89 @@
+module Day23 (part1, part2) where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+type Pt = (Int, Int)
+
+parse :: String -> Set.Set Pt
+parse = Set.fromList . concat . zipWith row [0 ..] . lines
+  where
+    row i l = [(i, j) | (j, c) <- zip [0 ..] l, c == '#']
+
+neighbors8 :: Pt -> [Pt]
+neighbors8 (i, j) =
+  [ (i + di, j + dj)
+    | di <- [-1 .. 1],
+      dj <- [-1 .. 1],
+      not (di == 0 && dj == 0)
+  ]
+
+hasNeighbor :: Set.Set Pt -> Pt -> Bool
+hasNeighbor s e = any (`Set.member` s) $ neighbors8 e
+
+dirs :: Pt -> [(Pt, [Pt])]
+dirs (i, j) =
+  let n = (i - 1, j)
+      s = (i + 1, j)
+      w = (i, j - 1)
+      e = (i, j + 1)
+      nw = (i - 1, j - 1)
+      ne = (i - 1, j + 1)
+      sw = (i + 1, j - 1)
+      se = (i + 1, j + 1)
+   in [ (n, [n, nw, ne]),
+        (s, [s, sw, se]),
+        (w, [w, nw, sw]),
+        (e, [e, ne, se])
+      ]
+
+propose :: Int -> Set.Set Pt -> Pt -> Maybe Pt
+propose r s e
+  | not (hasNeighbor s e) = Nothing
+  | otherwise =
+      let ord = take 4 $ drop (r `mod` 4) $ cycle $ dirs e
+          clear block = all (not . (`Set.member` s)) block
+       in case [d | (d, block) <- ord, clear block] of
+            (x : _) -> Just x
+            [] -> Nothing
+
+roundStep :: Int -> Set.Set Pt -> Set.Set Pt
+roundStep r s =
+  let elves = Set.toList s
+      prop e = propose r s e
+      byDest =
+        Map.fromListWith (++) [(d, [e]) | e <- elves, Just d <- [prop e]]
+      final e =
+        case prop e of
+          Nothing -> e
+          Just d
+            | length (Map.findWithDefault [] d byDest) == 1 -> d
+            | otherwise -> e
+   in Set.fromList $ map final elves
+
+emptyRect :: Set.Set Pt -> Int
+emptyRect s
+  | Set.null s = 0
+  | otherwise =
+      let is = Set.map fst s
+          js = Set.map snd s
+          imin = Set.findMin is
+          imax = Set.findMax is
+          jmin = Set.findMin js
+          jmax = Set.findMax js
+          area = (imax - imin + 1) * (jmax - jmin + 1)
+       in area - Set.size s
+
+part1 :: String -> Int
+part1 raw =
+  let s0 = parse raw
+      s10 = foldl (\s r -> roundStep r s) s0 [0 .. 9]
+   in emptyRect s10
+
+part2 :: String -> Int
+part2 raw =
+  let s0 = parse raw
+      go !r !s =
+        let s' = roundStep r s
+         in if s' == s then r + 1 else go (r + 1) s'
+   in go 0 s0
diff --git a/src/Day24.hs b/src/Day24.hs
new file mode 100644
index 0000000..89a1e5f
--- /dev/null
+++ b/src/Day24.hs
@@ -0,0 +1,97 @@
+module Day24 (part1, part2) where
+
+import Data.List (elemIndex)
+import Data.Maybe (fromJust)
+import qualified Data.Set as Set
+
+type Pt = (Int, Int)
+
+data Cell = Wall | Open | Blizzard Char
+  deriving (Eq)
+
+parse :: String -> ([[Cell]], Pt, Pt, Int, Int)
+parse raw =
+  let ls = lines raw
+      h = length ls
+      w = length (head ls)
+      grid =
+        [ [ cell c
+            | c <- row
+          ]
+          | row <- ls
+        ]
+      cell '#' = Wall
+      cell '.' = Open
+      cell x = Blizzard x
+      startJ = fromJust $ elemIndex '.' (head ls)
+      endJ = fromJust $ elemIndex '.' (last ls)
+   in (grid, (0, startJ), (h - 1, endJ), h, w)
+
+norm :: Int -> Int -> Int
+norm m x = (x `mod` m + m) `mod` m
+
+blizzAt :: [[Cell]] -> Int -> Int -> Int -> Set.Set Pt
+blizzAt grid t h w =
+  let innerH = h - 2
+      innerW = w - 2
+   in Set.fromList $
+        concat
+          [ case grid !! i !! j of
+              Blizzard d ->
+                let bi = i - 1
+                    bj = j - 1
+                    (ni, nj) = case d of
+                      '^' -> (norm innerH (bi - t), bj)
+                      'v' -> (norm innerH (bi + t), bj)
+                      '<' -> (bi, norm innerW (bj - t))
+                      '>' -> (bi, norm innerW (bj + t))
+                      _ -> error "Day24: blizzard"
+                 in [(ni + 1, nj + 1)]
+              _ -> []
+            | i <- [1 .. h - 2],
+              j <- [1 .. w - 2]
+          ]
+
+passable :: [[Cell]] -> Int -> Int -> Pt -> Bool
+passable grid h w (i, j)
+  | i < 0 || i >= h || j < 0 || j >= w = False
+  | otherwise = case grid !! i !! j of
+      Wall -> False
+      _ -> True
+
+neighbors :: Pt -> [Pt]
+neighbors (i, j) = [(i, j), (i - 1, j), (i + 1, j), (i, j - 1), (i, j + 1)]
+
+shortest :: [[Cell]] -> Pt -> Pt -> Int -> Int -> Int -> Int
+shortest grid start goal h w tStart =
+  let period = lcm (h - 2) (w - 2)
+      bl tt = blizzAt grid tt h w
+      go [] _ = error "Day24: no path"
+      go ((t, r, c) : q) vis
+        | (r, c) == goal = t
+        | (r, c, t `mod` period) `Set.member` vis = go q vis
+        | otherwise =
+            let vis' = Set.insert (r, c, t `mod` period) vis
+                t' = t + 1
+                bz = bl t'
+                nbrs =
+                  [ (t', nr, nc)
+                    | (nr, nc) <- neighbors (r, c),
+                      passable grid h w (nr, nc),
+                      not ((nr, nc) `Set.member` bz)
+                  ]
+             in go (q ++ nbrs) vis'
+   in go [(tStart, fst start, snd start)] Set.empty
+
+part1 :: String -> Int
+part1 s =
+  let (grid, start, goal, h, w) = parse s
+   in shortest grid start goal h w 0
+
+part2 :: String -> Int
+part2 s =
+  let (grid, start, goal, h, w) = parse s
+      t1 = shortest grid start goal h w 0
+      t2 = shortest grid goal start h w t1
+      t3 = shortest grid start goal h w t2
+   in t3
diff --git a/src/Day25.hs b/src/Day25.hs
new file mode 100644
index 0000000..334b2ab
--- /dev/null
+++ b/src/Day25.hs
@@ -0,0 +1,33 @@
+module Day25 (part1, part2) where
+
+snafuDigit :: Char -> Integer
+snafuDigit '=' = -2
+snafuDigit '-' = -1
+snafuDigit '0' = 0
+snafuDigit '1' = 1
+snafuDigit '2' = 2
+snafuDigit _ = error "Day25: digit"
+
+fromSnafu :: String -> Integer
+fromSnafu = foldl (\acc c -> acc * 5 + snafuDigit c) 0
+
+toSnafu :: Integer -> String
+toSnafu 0 = "0"
+toSnafu n =
+  let (q, r) = n `divMod` 5
+      (q', ch) = case r of
+        0 -> (q, '0')
+        1 -> (q, '1')
+        2 -> (q, '2')
+        3 -> (q + 1, '=')
+        4 -> (q + 1, '-')
+        _ -> error "Day25: mod"
+   in toSnafu q' ++ [ch]
+
+part1 :: String -> String
+part1 s =
+  let nums = map fromSnafu $ lines s
+   in toSnafu $ sum nums
+
+part2 :: String -> String
+part2 _ = "Merry Christmas!"
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..b593668
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,103 @@
+module Main (main) where
+
+import AOC.Input (getInput, year)
+import System.Environment (getArgs)
+
+import qualified Day01
+import qualified Day02
+import qualified Day03
+import qualified Day04
+import qualified Day05
+import qualified Day06
+import qualified Day07
+import qualified Day08
+import qualified Day09
+import qualified Day10
+import qualified Day11
+import qualified Day12
+import qualified Day13
+import qualified Day14
+import qualified Day15
+import qualified Day16
+import qualified Day17
+import qualified Day18
+import qualified Day19
+import qualified Day20
+import qualified Day21
+import qualified Day22
+import qualified Day23
+import qualified Day24
+import qualified Day25
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    [] -> mapM_ runDay [1 .. 25]
+    [d] -> runDay (read d)
+    [d, p] -> runPart (read d) (read p)
+    _ -> fail "Usage: aoc2022 [day [part]]"
+
+runDay :: Int -> IO ()
+runDay d = runPart d 1 >> runPart d 2
+
+runPart :: Int -> Int -> IO ()
+runPart day part = do
+  raw <- getInput day
+  putStrLn $ "Year " ++ show year ++ " Day " ++ pad day ++ " Part " ++ show part ++ ": " ++ solve day part raw
+  where
+    pad n | n < 10 = '0' : show n
+          | otherwise = show n
+
+solve :: Int -> Int -> String -> String
+solve 1 1 = show . Day01.part1
+solve 1 2 = show . Day01.part2
+solve 2 1 = show . Day02.part1
+solve 2 2 = show . Day02.part2
+solve 3 1 = show . Day03.part1
+solve 3 2 = show . Day03.part2
+solve 4 1 = show . Day04.part1
+solve 4 2 = show . Day04.part2
+solve 5 1 = Day05.part1
+solve 5 2 = Day05.part2
+solve 6 1 = show . Day06.part1
+solve 6 2 = show . Day06.part2
+solve 7 1 = show . Day07.part1
+solve 7 2 = show . Day07.part2
+solve 8 1 = show . Day08.part1
+solve 8 2 = show . Day08.part2
+solve 9 1 = show . Day09.part1
+solve 9 2 = show . Day09.part2
+solve 10 1 = show . Day10.part1
+solve 10 2 = Day10.part2
+solve 11 1 = show . Day11.part1
+solve 11 2 = show . Day11.part2
+solve 12 1 = show . Day12.part1
+solve 12 2 = show . Day12.part2
+solve 13 1 = show . Day13.part1
+solve 13 2 = show . Day13.part2
+solve 14 1 = show . Day14.part1
+solve 14 2 = show . Day14.part2
+solve 15 1 = show . Day15.part1
+solve 15 2 = show . Day15.part2
+solve 16 1 = show . Day16.part1
+solve 16 2 = show . Day16.part2
+solve 17 1 = show . Day17.part1
+solve 17 2 = show . Day17.part2
+solve 18 1 = show . Day18.part1
+solve 18 2 = show . Day18.part2
+solve 19 1 = show . Day19.part1
+solve 19 2 = show . Day19.part2
+solve 20 1 = show . Day20.part1
+solve 20 2 = show . Day20.part2
+solve 21 1 = show . Day21.part1
+solve 21 2 = show . Day21.part2
+solve 22 1 = show . Day22.part1
+solve 22 2 = show . Day22.part2
+solve 23 1 = show . Day23.part1
+solve 23 2 = show . Day23.part2
+solve 24 1 = show . Day24.part1
+solve 24 2 = show . Day24.part2
+solve 25 1 = Day25.part1
+solve 25 2 = Day25.part2
+solve d p = error $ "No solution for day " ++ show d ++ " part " ++ show p