From bd37404d0ef107c5944ff5ff2df9147ff5285f09 Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sat, 2 Jan 2021 19:27:30 -0800
Subject: [PATCH 1/7] Setup Day 23

---
 AdventOfCode2020.cabal     |  2 +
 src/Day23/README.md        | 83 ++++++++++++++++++++++++++++++++++++++
 src/Day23/Solution.hs      |  7 ++++
 test/Day23/SolutionSpec.hs | 14 +++++++
 test/Day23/input.txt       |  1 +
 5 files changed, 107 insertions(+)
 create mode 100644 src/Day23/README.md
 create mode 100644 src/Day23/Solution.hs
 create mode 100644 test/Day23/SolutionSpec.hs
 create mode 100644 test/Day23/input.txt

diff --git a/AdventOfCode2020.cabal b/AdventOfCode2020.cabal
index 97c9d36..19cc181 100644
--- a/AdventOfCode2020.cabal
+++ b/AdventOfCode2020.cabal
@@ -53,6 +53,7 @@ library
       Day18.Solution
       Day20.Solution
       Day21.Solution
+      Day23.Solution
       Practice.Foldable
       Template.Solution
   other-modules:
@@ -99,6 +100,7 @@ test-suite AdventOfCode2020-test
       Day18.SolutionSpec
       Day20.SolutionSpec
       Day21.SolutionSpec
+      Day23.SolutionSpec
       Practice.FoldableSpec
       Template.SolutionSpec
       Paths_AdventOfCode2020
diff --git a/src/Day23/README.md b/src/Day23/README.md
new file mode 100644
index 0000000..3ed85fe
--- /dev/null
+++ b/src/Day23/README.md
@@ -0,0 +1,83 @@
+## Day 23: Crab Cups
+
+The small crab challenges _you_ to a game! The crab is going to mix up some cups, and you have to predict where they'll end up.
+
+The cups will be arranged in a circle and labeled _clockwise_ (your puzzle input). For example, if your labeling were `32415` , there would be five cups in the circle; going clockwise around the circle from the first cup, the cups would be labeled `3` , `2` , `4` , `1` , `5` , and then back to `3` again.
+
+Before the crab starts, it will designate the first cup in your list as the _current cup_ . The crab is then going to do _100 moves_ .
+
+Each _move_ , the crab does the following actions:
+
+- The crab picks up the _three cups_ that are immediately _clockwise_ of the _current cup_ . They are removed from the circle; cup spacing is adjusted as necessary to maintain the circle.
+- The crab selects a _destination cup_ : the cup with a _label_ equal to the _current cup's_ label minus one. If this would select one of the cups that was just picked up, the crab will keep subtracting one until it finds a cup that wasn't just picked up. If at any point in this process the value goes below the lowest value on any cup's label, it _wraps around_ to the highest value on any cup's label instead.
+- The crab places the cups it just picked up so that they are _immediately clockwise_ of the destination cup. They keep the same order as when they were picked up.
+- The crab selects a new _current cup_ : the cup which is immediately clockwise of the current cup.
+
+For example, suppose your cup labeling were `389125467` . If the crab were to do merely 10 moves, the following changes would occur:
+
+```
+-- move 1 --
+cups: (3) 8  9  1  2  5  4  6  7
+pick up: 8, 9, 1
+destination: 2
+
+-- move 2 --
+cups:  3 (2) 8  9  1  5  4  6  7
+pick up: 8, 9, 1
+destination: 7
+
+-- move 3 --
+cups:  3  2 (5) 4  6  7  8  9  1
+pick up: 4, 6, 7
+destination: 3
+
+-- move 4 --
+cups:  7  2  5 (8) 9  1  3  4  6
+pick up: 9, 1, 3
+destination: 7
+
+-- move 5 --
+cups:  3  2  5  8 (4) 6  7  9  1
+pick up: 6, 7, 9
+destination: 3
+
+-- move 6 --
+cups:  9  2  5  8  4 (1) 3  6  7
+pick up: 3, 6, 7
+destination: 9
+
+-- move 7 --
+cups:  7  2  5  8  4  1 (9) 3  6
+pick up: 3, 6, 7
+destination: 8
+
+-- move 8 --
+cups:  8  3  6  7  4  1  9 (2) 5
+pick up: 5, 8, 3
+destination: 1
+
+-- move 9 --
+cups:  7  4  1  5  8  3  9  2 (6)
+pick up: 7, 4, 1
+destination: 5
+
+-- move 10 --
+cups: (5) 7  4  1  8  3  9  2  6
+pick up: 7, 4, 1
+destination: 3
+
+-- final --
+cups:  5 (8) 3  7  4  1  9  2  6
+```
+
+In the above example, the cups' values are the labels as they appear moving clockwise around the circle; the _current cup_ is marked with `( )` .
+
+After the crab is done, what order will the cups be in? Starting _after the cup labeled `1`_ , collect the other cups' labels clockwise into a single string with no extra characters; each number except `1` should appear exactly once. In the above example, after 10 moves, the cups clockwise from `1` are labeled `9` , `2` , `6` , `5` , and so on, producing _`92658374`_ . If the crab were to complete all 100 moves, the order after cup `1` would be _`67384529`_ .
+
+Using your labeling, simulate 100 moves. _What are the labels on the cups after cup `1` ?_
+
+## Link
+
+[https://adventofcode.com/2020/day/23][1]
+
+[1]: https://adventofcode.com/2020/day/23
diff --git a/src/Day23/Solution.hs b/src/Day23/Solution.hs
new file mode 100644
index 0000000..06917f5
--- /dev/null
+++ b/src/Day23/Solution.hs
@@ -0,0 +1,7 @@
+module Day23.Solution where
+
+part1 :: String -> String
+part1 = head . lines
+
+part2 :: String -> String
+part2 = head . lines
diff --git a/test/Day23/SolutionSpec.hs b/test/Day23/SolutionSpec.hs
new file mode 100644
index 0000000..9ef2d75
--- /dev/null
+++ b/test/Day23/SolutionSpec.hs
@@ -0,0 +1,14 @@
+module Day23.SolutionSpec (spec) where
+
+import Day23.Solution
+import Test.Hspec
+
+spec :: Spec
+spec = parallel $ do
+  xit "solves Part 1" $ do
+    input <- readFile "./test/Day23/input.txt"
+    part1 input `shouldBe` "hello_santa"
+
+  xit "solves Part 2" $ do
+    input <- readFile "./test/Day23/input.txt"
+    part2 input `shouldBe` "hello_santa"
diff --git a/test/Day23/input.txt b/test/Day23/input.txt
new file mode 100644
index 0000000..85e58d4
--- /dev/null
+++ b/test/Day23/input.txt
@@ -0,0 +1 @@
+789465123

From da576947d80fa7f93196932a3b3d6c25628c8f87 Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sat, 9 Jan 2021 15:37:02 -0800
Subject: [PATCH 2/7] Solve part 1

---
 AdventOfCode2020.cabal         |   4 +-
 src/Day23/CircularList.hs      |  87 ++++++++++++++++++++++++
 src/Day23/Solution.hs          |  25 ++++++-
 stack.yaml                     |   4 +-
 stack.yaml.lock                |  24 +++----
 test/Day23/CircularListSpec.hs | 118 +++++++++++++++++++++++++++++++++
 test/Day23/SolutionSpec.hs     |  35 +++++++++-
 7 files changed, 279 insertions(+), 18 deletions(-)
 create mode 100644 src/Day23/CircularList.hs
 create mode 100644 test/Day23/CircularListSpec.hs

diff --git a/AdventOfCode2020.cabal b/AdventOfCode2020.cabal
index 19cc181..c30bbc9 100644
--- a/AdventOfCode2020.cabal
+++ b/AdventOfCode2020.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.2.
+-- This file has been generated from package.yaml by hpack version 0.34.3.
 --
 -- see: https://github.com/sol/hpack
 
@@ -53,6 +53,7 @@ library
       Day18.Solution
       Day20.Solution
       Day21.Solution
+      Day23.CircularList
       Day23.Solution
       Practice.Foldable
       Template.Solution
@@ -100,6 +101,7 @@ test-suite AdventOfCode2020-test
       Day18.SolutionSpec
       Day20.SolutionSpec
       Day21.SolutionSpec
+      Day23.CircularListSpec
       Day23.SolutionSpec
       Practice.FoldableSpec
       Template.SolutionSpec
diff --git a/src/Day23/CircularList.hs b/src/Day23/CircularList.hs
new file mode 100644
index 0000000..6c99d8e
--- /dev/null
+++ b/src/Day23/CircularList.hs
@@ -0,0 +1,87 @@
+module Day23.CircularList where
+
+import Data.Foldable
+import Data.Function
+import Data.Sequence (Seq (..), (><))
+import qualified Data.Sequence as Seq
+import Prelude hiding (drop, take)
+
+newtype CircularList a = CList {getCList :: (Seq a, Seq a, Seq a)}
+
+instance Show a => Show (CircularList a) where
+  show (CList (xs, ys, _)) = show (xs >< ys)
+
+instance Eq a => Eq (CircularList a) where
+  (CList (as, bs, _)) == (CList (xs, ys, _)) = as >< bs == xs >< ys
+
+instance Foldable CircularList where
+  foldMap f (CList (xs, ys, _)) = foldMap f (xs >< ys)
+
+fromList :: [a] -> CircularList a
+fromList xs = CList (Seq.fromList xs, Empty, Empty)
+
+toList :: CircularList a -> [a]
+toList = Data.Foldable.toList
+
+takeR :: Int -> CircularList a -> [a]
+takeR n _ | n < 0 = error "n must be a positive Int"
+takeR 0 _ = []
+takeR n (CList (x :<| xs, ys, zs)) = x : takeR (pred n) (CList (xs, ys :|> x, zs))
+takeR n (CList (Empty, ys, zs)) = takeR n (CList (ys, Empty, zs))
+
+dropR :: Int -> CircularList a -> CircularList a
+dropR n = snd . dropR' n
+
+dropR' :: Int -> CircularList a -> (Seq a, CircularList a)
+dropR' n' cList = go n' (Empty, cList)
+  where
+    go :: Int -> (Seq a, CircularList a) -> (Seq a, CircularList a)
+    go n _ | n < 0 = error "n must be a positive Int"
+    go 0 result = result
+    go n (bs, CList (x :<| xs, ys, zs)) = go (pred n) (bs :|> x, CList (xs, ys, zs))
+    go n (bs, CList (Empty, ys, zs)) = go n (bs, CList (ys, Empty, zs))
+
+skipR :: Int -> CircularList a -> CircularList a
+skipR n _ | n < 0 = error "n must be a positive Int"
+skipR 0 xs = xs
+skipR n (CList (x :<| xs, ys, zs)) = skipR (pred n) (CList (xs, ys :|> x, zs))
+skipR n (CList (Empty, ys, zs)) = skipR n (CList (ys, Empty, zs))
+
+skipL :: Int -> CircularList a -> CircularList a
+skipL n _ | n < 0 = error "n must be a positive Int"
+skipL 0 xs = xs
+skipL n (CList (xs, ys :|> y, zs)) = skipL (pred n) (CList (y :<| xs, ys, zs))
+skipL n (CList (xs, Empty, zs)) = skipL n (CList (Empty, xs, zs))
+
+skipWhileR :: (a -> Bool) -> CircularList a -> CircularList a
+skipWhileR p = when (p . peek) (skipWhileR p . skipR 1)
+
+cons :: a -> CircularList a -> CircularList a
+cons x (CList (xs, ys, zs)) = CList (x :<| xs, ys, zs)
+
+insertMany :: Foldable t => t a -> CircularList a -> CircularList a
+insertMany xs cl = foldr cons cl xs
+
+peek :: CircularList a -> a
+peek (CList (x :<| _, _, _)) = x
+peek (CList (Empty, ys, zs)) = peek (CList (ys, Empty, zs))
+
+yankR :: Int -> CircularList a -> CircularList a
+yankR n = go . dropR' n
+  where
+    go :: (Seq a, CircularList a) -> CircularList a
+    go (zs, CList (xs, ys, _)) = CList (xs, ys, zs)
+
+putR :: CircularList a -> CircularList a
+putR (CList (xs, ys, zs)) = insertMany zs (CList (xs, ys, Empty))
+
+sortBy :: Eq a => (a -> a -> Ordering) -> CircularList a -> CircularList a
+sortBy fn (CList (xs, ys, zs)) = CList (Seq.sortBy fn (a :<| as), Empty, zs) & skipWhileR (/= a)
+  where
+    (a :<| as) = xs >< ys
+
+sort :: (Eq a, Ord a) => CircularList a -> CircularList a
+sort = sortBy compare
+
+when :: (p -> Bool) -> (p -> p) -> p -> p
+when p fn target = if p target then fn target else target
diff --git a/src/Day23/Solution.hs b/src/Day23/Solution.hs
index 06917f5..b3d77d0 100644
--- a/src/Day23/Solution.hs
+++ b/src/Day23/Solution.hs
@@ -1,7 +1,30 @@
 module Day23.Solution where
 
+import Advent.Utils
+import Day23.CircularList
+
 part1 :: String -> String
-part1 = head . lines
+part1 = cupOrder . moves 100 . parseCircularList
 
 part2 :: String -> String
 part2 = head . lines
+
+parseCircularList :: String -> CircularList Int
+parseCircularList = fromList . map (readInt . pure) . head . lines
+
+move :: CircularList Int -> CircularList Int
+move = putAtDestination . skipL 1 . yankR 3 . skipR 1
+  where
+    putAtDestination cl =
+      let current = peek cl
+          destination = (peek . skipL 1 . sort) cl
+       in skipR 1 . skipWhileR (/= current) . putR . skipR 1 . skipWhileR (/= destination) $ cl
+
+moves :: Int -> CircularList Int -> CircularList Int
+moves n
+  | n < 0 = undefined
+  | n == 0 = id
+  | otherwise = moves (pred n) . move
+
+cupOrder :: CircularList Int -> String
+cupOrder = concatMap show . tail . toList . skipWhileR (/= 1)
diff --git a/stack.yaml b/stack.yaml
index 034e5a0..f96cc90 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-16.23
+resolver: lts-16.28
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -40,7 +40,7 @@ packages:
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
 extra-deps:
-  - implicit-hie-0.1.2.4
+  - implicit-hie-0.1.2.5
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
diff --git a/stack.yaml.lock b/stack.yaml.lock
index b8b99fe..06a8d0a 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -4,16 +4,16 @@
 #   https://docs.haskellstack.org/en/stable/lock_files
 
 packages:
-- completed:
-    hackage: implicit-hie-0.1.2.4@sha256:963fcc1b1136ccfd814bc7182bcb841cc51db18b38f5d45860195aed0ca94ab6,2998
-    pantry-tree:
-      size: 844
-      sha256: 25ca5d85e30d0a5a7a1f34420848ab163221b53198dbf2e54090f5ae9050d5b1
-  original:
-    hackage: implicit-hie-0.1.2.4
+  - completed:
+      hackage: implicit-hie-0.1.2.4@sha256:963fcc1b1136ccfd814bc7182bcb841cc51db18b38f5d45860195aed0ca94ab6,2998
+      pantry-tree:
+        size: 844
+        sha256: 25ca5d85e30d0a5a7a1f34420848ab163221b53198dbf2e54090f5ae9050d5b1
+    original:
+      hackage: implicit-hie-0.1.2.5
 snapshots:
-- completed:
-    size: 532832
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/23.yaml
-    sha256: fbb2a0519008533924c7753bd7164ddd1009f09504eb06674acad6049b46db09
-  original: lts-16.23
+  - completed:
+      size: 533053
+      url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/28.yaml
+      sha256: a9c01d860ac8dfb3a1b6f7ec4a36dd9504a95392b89c99b0877da63fa36a8e97
+    original: lts-16.28
diff --git a/test/Day23/CircularListSpec.hs b/test/Day23/CircularListSpec.hs
new file mode 100644
index 0000000..033653b
--- /dev/null
+++ b/test/Day23/CircularListSpec.hs
@@ -0,0 +1,118 @@
+module Day23.CircularListSpec (spec) where
+
+import Control.Exception
+import Data.Function
+import Data.Sequence (Seq (..))
+import qualified Data.Sequence as Seq
+import Day23.CircularList
+import Test.Hspec
+
+spec :: Spec
+spec = parallel $ do
+  let exampleList = [3, 8, 9, 1, 2, 5, 4, 6, 7] :: [Int]
+  let exampleCList = fromList exampleList
+
+  describe "fromList" $ do
+    it "creates a circular list" $ do
+      fromList exampleList `shouldBe` CList (Seq.fromList exampleList, Empty, Empty)
+
+  describe "toList" $ do
+    it "creates a list from a circular list" $ do
+      toList exampleCList `shouldBe` exampleList
+
+  describe "show" $ do
+    it "shows each element in the list" $ do
+      show exampleCList `shouldBe` "fromList [3,8,9,1,2,5,4,6,7]"
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 3 & show) `shouldBe` "fromList [1,2,5,4,6,7,3,8,9]"
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & skipR (-2)) `shouldThrow` anyException
+
+  describe "takeR" $ do
+    it "takes elements from the list" $ do
+      (exampleCList & takeR 3) `shouldBe` [3, 8, 9]
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 7 & takeR 3) `shouldBe` [6, 7, 3]
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & takeR (-2)) `shouldThrow` anyException
+
+  describe "dropR" $ do
+    it "drops elements from the list" $ do
+      (exampleCList & dropR 3) `shouldBe` fromList [1, 2, 5, 4, 6, 7]
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 7 & dropR 3) `shouldBe` fromList [8, 9, 1, 2, 5, 4]
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & dropR (-2)) `shouldThrow` anyException
+
+  describe "dropR'" $ do
+    it "it returns the dropped elements" $ do
+      (exampleCList & dropR' 3) `shouldBe` (Seq.fromList [3, 8, 9], fromList [1, 2, 5, 4, 6, 7])
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 7 & dropR' 3) `shouldBe` (Seq.fromList [6, 7, 3], fromList [8, 9, 1, 2, 5, 4])
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & dropR' (-2)) `shouldThrow` anyException
+
+  describe "skipR" $ do
+    it "skips elements on the list without removing them" $ do
+      (exampleCList & skipR 3) `shouldBe` fromList [1, 2, 5, 4, 6, 7, 3, 8, 9]
+    it "wraps the circular part" $ do
+      (exampleCList & skipR (3 + length exampleList)) `shouldBe` fromList [1, 2, 5, 4, 6, 7, 3, 8, 9]
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & skipR (-2)) `shouldThrow` anyException
+
+  describe "skipL" $ do
+    it "skips elements on the list without removing them" $ do
+      (exampleCList & skipL 3) `shouldBe` fromList [4, 6, 7, 3, 8, 9, 1, 2, 5]
+    it "wraps the circular part" $ do
+      (exampleCList & skipL (3 + length exampleList)) `shouldBe` fromList [4, 6, 7, 3, 8, 9, 1, 2, 5]
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & skipL (-2)) `shouldThrow` anyException
+
+  describe "skipWhileR" $ do
+    it "skips elements on the list without removing them" $ do
+      (exampleCList & skipWhileR (/= 1)) `shouldBe` fromList [1, 2, 5, 4, 6, 7, 3, 8, 9]
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 3 & skipWhileR (/= 3)) `shouldBe` exampleCList
+
+  describe "cons" $ do
+    it "inserts a value at the current position" $ do
+      (exampleCList & cons 13) `shouldBe` fromList [13, 3, 8, 9, 1, 2, 5, 4, 6, 7]
+    it "wraps the circular part" $ do
+      (exampleCList & skipL 1 & cons 13) `shouldBe` fromList [13, 7, 3, 8, 9, 1, 2, 5, 4, 6]
+
+  describe "insertMany" $ do
+    it "inserts a value at the current position" $ do
+      (exampleCList & insertMany [13, 17, 19]) `shouldBe` fromList [13, 17, 19, 3, 8, 9, 1, 2, 5, 4, 6, 7]
+    it "wraps the circular part" $ do
+      (exampleCList & skipL 1 & insertMany [13, 17, 19]) `shouldBe` fromList [13, 17, 19, 7, 3, 8, 9, 1, 2, 5, 4, 6]
+
+  describe "peek" $ do
+    it "shows the current value" $ do
+      (exampleCList & peek) `shouldBe` 3
+
+  describe "yankR" $ do
+    it "cuts elements from the list" $ do
+      (exampleCList & yankR 3) `shouldBe` fromList [1, 2, 5, 4, 6, 7]
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 7 & yankR 3) `shouldBe` fromList [8, 9, 1, 2, 5, 4]
+    it "is an error when n is negative" $ do
+      evaluate (exampleCList & yankR (-3)) `shouldThrow` anyException
+
+  describe "putR" $ do
+    it "is an identity" $ do
+      (exampleCList & putR) `shouldBe` exampleCList
+    it "is the duel of a yankR" $ do
+      (exampleCList & yankR 3 & putR) `shouldBe` exampleCList
+    it "wraps the circular part" $ do
+      (exampleCList & skipR 7 & yankR 3 & putR) `shouldBe` fromList [6, 7, 3, 8, 9, 1, 2, 5, 4]
+    it "lift and shift sections of the list" $ do
+      (exampleCList & skipR 1 & yankR 3 & skipR 1 & putR) `shouldBe` fromList [8, 9, 1, 5, 4, 6, 7, 3, 2]
+
+  describe "sortBy" $ do
+    it "sorts elements" $ do
+      {- HLINT ignore "Use sort" -}
+      (exampleCList & sortBy compare) `shouldBe` fromList [3, 4, 5, 6, 7, 8, 9, 1, 2]
+    it "sorts elements" $ do
+      (exampleCList & sort) `shouldBe` fromList [3, 4, 5, 6, 7, 8, 9, 1, 2]
+    it "sorts elements in reverse" $ do
+      (exampleCList & sortBy (flip compare)) `shouldBe` fromList [3, 2, 1, 9, 8, 7, 6, 5, 4]
diff --git a/test/Day23/SolutionSpec.hs b/test/Day23/SolutionSpec.hs
index 9ef2d75..c796e75 100644
--- a/test/Day23/SolutionSpec.hs
+++ b/test/Day23/SolutionSpec.hs
@@ -1,14 +1,45 @@
 module Day23.SolutionSpec (spec) where
 
+import Data.Foldable (for_)
+import Day23.CircularList
 import Day23.Solution
 import Test.Hspec
 
 spec :: Spec
 spec = parallel $ do
-  xit "solves Part 1" $ do
+  it "solves Part 1" $ do
     input <- readFile "./test/Day23/input.txt"
-    part1 input `shouldBe` "hello_santa"
+    part1 input `shouldBe` "98752463"
 
   xit "solves Part 2" $ do
     input <- readFile "./test/Day23/input.txt"
     part2 input `shouldBe` "hello_santa"
+
+  let exampleCList = fromList [3, 8, 9, 1, 2, 5, 4, 6, 7]
+  describe "parseCircularList" $ do
+    it "reads a list of int characters" $ do
+      parseCircularList "389125467" `shouldBe` exampleCList
+
+  describe "moves" $ do
+    let cases =
+          [ (1, [2, 8, 9, 1, 5, 4, 6, 7, 3]),
+            (2, [5, 4, 6, 7, 8, 9, 1, 3, 2]),
+            (3, [8, 9, 1, 3, 4, 6, 7, 2, 5]),
+            (4, [4, 6, 7, 9, 1, 3, 2, 5, 8]),
+            (5, [1, 3, 6, 7, 9, 2, 5, 8, 4]),
+            (6, [9, 3, 6, 7, 2, 5, 8, 4, 1]),
+            (7, [2, 5, 8, 3, 6, 7, 4, 1, 9]),
+            (8, [6, 7, 4, 1, 5, 8, 3, 9, 2]),
+            (9, [5, 7, 4, 1, 8, 3, 9, 2, 6]),
+            (10, [8, 3, 7, 4, 1, 9, 2, 6, 5])
+          ]
+    let test (input, expected) = it ("walks through move " ++ show input) $ do
+          (toList . moves input) exampleCList `shouldBe` expected
+
+    for_ cases test
+
+  describe "cupOrder" $ do
+    it "is 92658374 after 10 moves" $ do
+      (cupOrder . moves 10) exampleCList `shouldBe` "92658374"
+    it "is 92658374 after 100 moves" $ do
+      (cupOrder . moves 100) exampleCList `shouldBe` "67384529"

From bce8b1ddebf75dc2925ba534f970536015892d97 Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sat, 9 Jan 2021 15:37:58 -0800
Subject: [PATCH 3/7] Update readme to include part 2

---
 src/Day23/README.md | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/src/Day23/README.md b/src/Day23/README.md
index 3ed85fe..eb86ab5 100644
--- a/src/Day23/README.md
+++ b/src/Day23/README.md
@@ -76,6 +76,20 @@ After the crab is done, what order will the cups be in? Starting _after the cup
 
 Using your labeling, simulate 100 moves. _What are the labels on the cups after cup `1` ?_
 
+## Part Two
+
+Due to what you can only assume is a mistranslation (you're not exactly fluent in Crab ), you are quite surprised when the crab starts arranging _many_ cups in a circle on your raft - _one million_ ( `1000000` ) in total.
+
+Your labeling is still correct for the first few cups; after that, the remaining cups are just numbered in an increasing fashion starting from the number after the highest number in your list and proceeding one by one until one million is reached. (For example, if your labeling were `54321` , the cups would be numbered `5` , `4` , `3` , `2` , `1` , and then start counting up from `6` until one million is reached.) In this way, every number from one through one million is used exactly once.
+
+After discovering where you made the mistake in translating Crab Numbers, you realize the small crab isn't going to do merely 100 moves; the crab is going to do _ten million_ ( `10000000` ) moves!
+
+The crab is going to hide your _stars_ \- one each - under the _two cups that will end up immediately clockwise of cup `1`_ . You can have them if you predict what the labels on those cups will be when the crab is finished.
+
+In the above example ( `389125467` ), this would be `934001` and then `159792` ; multiplying these together produces _`149245887792`_ .
+
+Determine which two cups will end up immediately clockwise of cup `1` . _What do you get if you multiply their labels together?_
+
 ## Link
 
 [https://adventofcode.com/2020/day/23][1]

From f23f8817acaed80755a306cf20603e80aa10e918 Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sat, 9 Jan 2021 17:13:35 -0800
Subject: [PATCH 4/7] Solve part 2 attempt 1

---
 src/Day23/Solution.hs      | 3 +++
 test/Day23/SolutionSpec.hs | 8 ++++++++
 2 files changed, 11 insertions(+)

diff --git a/src/Day23/Solution.hs b/src/Day23/Solution.hs
index b3d77d0..88138ae 100644
--- a/src/Day23/Solution.hs
+++ b/src/Day23/Solution.hs
@@ -28,3 +28,6 @@ moves n
 
 cupOrder :: CircularList Int -> String
 cupOrder = concatMap show . tail . toList . skipWhileR (/= 1)
+
+fillCups :: [Int] -> [Int]
+fillCups xs = xs ++ [(maximum xs + 1) .. 1000000]
diff --git a/test/Day23/SolutionSpec.hs b/test/Day23/SolutionSpec.hs
index c796e75..97d2611 100644
--- a/test/Day23/SolutionSpec.hs
+++ b/test/Day23/SolutionSpec.hs
@@ -43,3 +43,11 @@ spec = parallel $ do
       (cupOrder . moves 10) exampleCList `shouldBe` "92658374"
     it "is 92658374 after 100 moves" $ do
       (cupOrder . moves 100) exampleCList `shouldBe` "67384529"
+
+  describe "fillCups" $ do
+    it "creats a million cups" $ do
+      length (fillCups [3, 8, 9, 1, 2, 5, 4, 6, 7]) `shouldBe` length [1 :: Int .. 1000000]
+
+  context "when running 10 000 000 rounds" $ do
+    it "works" $ do
+      (takeR 2 . skipR 1 . skipWhileR (/= 1) . moves 1 . fromList . fillCups) [3, 8, 9, 1, 2, 5, 4, 6, 7] `shouldBe` [934001, 159792]

From fc5dfea0a1217ab39e859f1c9efff6bda0f4cbe6 Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sat, 9 Jan 2021 21:08:21 -0800
Subject: [PATCH 5/7] Solve part 2

---
 AdventOfCode2020.cabal         |   4 +-
 package.yaml                   |   1 +
 src/Day23/CircularList.hs      |  87 ------------------------
 src/Day23/Solution.hs          |  75 ++++++++++++++++-----
 test/Day23/CircularListSpec.hs | 118 ---------------------------------
 test/Day23/SolutionSpec.hs     |  45 ++++++++-----
 6 files changed, 89 insertions(+), 241 deletions(-)
 delete mode 100644 src/Day23/CircularList.hs
 delete mode 100644 test/Day23/CircularListSpec.hs

diff --git a/AdventOfCode2020.cabal b/AdventOfCode2020.cabal
index c30bbc9..9f6756e 100644
--- a/AdventOfCode2020.cabal
+++ b/AdventOfCode2020.cabal
@@ -53,7 +53,6 @@ library
       Day18.Solution
       Day20.Solution
       Day21.Solution
-      Day23.CircularList
       Day23.Solution
       Practice.Foldable
       Template.Solution
@@ -68,6 +67,7 @@ library
   build-depends:
       base >=4.7 && <5
     , containers
+    , mtl
     , parsec
   default-language: Haskell2010
 
@@ -101,7 +101,6 @@ test-suite AdventOfCode2020-test
       Day18.SolutionSpec
       Day20.SolutionSpec
       Day21.SolutionSpec
-      Day23.CircularListSpec
       Day23.SolutionSpec
       Practice.FoldableSpec
       Template.SolutionSpec
@@ -120,5 +119,6 @@ test-suite AdventOfCode2020-test
     , hspec
     , hspec-discover
     , hspec-golden
+    , mtl
     , parsec
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index 3bdf34c..606c65a 100644
--- a/package.yaml
+++ b/package.yaml
@@ -23,6 +23,7 @@ dependencies:
 - base >= 4.7 && < 5
 - parsec
 - containers
+- mtl
 
 library:
   source-dirs: src
diff --git a/src/Day23/CircularList.hs b/src/Day23/CircularList.hs
deleted file mode 100644
index 6c99d8e..0000000
--- a/src/Day23/CircularList.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-module Day23.CircularList where
-
-import Data.Foldable
-import Data.Function
-import Data.Sequence (Seq (..), (><))
-import qualified Data.Sequence as Seq
-import Prelude hiding (drop, take)
-
-newtype CircularList a = CList {getCList :: (Seq a, Seq a, Seq a)}
-
-instance Show a => Show (CircularList a) where
-  show (CList (xs, ys, _)) = show (xs >< ys)
-
-instance Eq a => Eq (CircularList a) where
-  (CList (as, bs, _)) == (CList (xs, ys, _)) = as >< bs == xs >< ys
-
-instance Foldable CircularList where
-  foldMap f (CList (xs, ys, _)) = foldMap f (xs >< ys)
-
-fromList :: [a] -> CircularList a
-fromList xs = CList (Seq.fromList xs, Empty, Empty)
-
-toList :: CircularList a -> [a]
-toList = Data.Foldable.toList
-
-takeR :: Int -> CircularList a -> [a]
-takeR n _ | n < 0 = error "n must be a positive Int"
-takeR 0 _ = []
-takeR n (CList (x :<| xs, ys, zs)) = x : takeR (pred n) (CList (xs, ys :|> x, zs))
-takeR n (CList (Empty, ys, zs)) = takeR n (CList (ys, Empty, zs))
-
-dropR :: Int -> CircularList a -> CircularList a
-dropR n = snd . dropR' n
-
-dropR' :: Int -> CircularList a -> (Seq a, CircularList a)
-dropR' n' cList = go n' (Empty, cList)
-  where
-    go :: Int -> (Seq a, CircularList a) -> (Seq a, CircularList a)
-    go n _ | n < 0 = error "n must be a positive Int"
-    go 0 result = result
-    go n (bs, CList (x :<| xs, ys, zs)) = go (pred n) (bs :|> x, CList (xs, ys, zs))
-    go n (bs, CList (Empty, ys, zs)) = go n (bs, CList (ys, Empty, zs))
-
-skipR :: Int -> CircularList a -> CircularList a
-skipR n _ | n < 0 = error "n must be a positive Int"
-skipR 0 xs = xs
-skipR n (CList (x :<| xs, ys, zs)) = skipR (pred n) (CList (xs, ys :|> x, zs))
-skipR n (CList (Empty, ys, zs)) = skipR n (CList (ys, Empty, zs))
-
-skipL :: Int -> CircularList a -> CircularList a
-skipL n _ | n < 0 = error "n must be a positive Int"
-skipL 0 xs = xs
-skipL n (CList (xs, ys :|> y, zs)) = skipL (pred n) (CList (y :<| xs, ys, zs))
-skipL n (CList (xs, Empty, zs)) = skipL n (CList (Empty, xs, zs))
-
-skipWhileR :: (a -> Bool) -> CircularList a -> CircularList a
-skipWhileR p = when (p . peek) (skipWhileR p . skipR 1)
-
-cons :: a -> CircularList a -> CircularList a
-cons x (CList (xs, ys, zs)) = CList (x :<| xs, ys, zs)
-
-insertMany :: Foldable t => t a -> CircularList a -> CircularList a
-insertMany xs cl = foldr cons cl xs
-
-peek :: CircularList a -> a
-peek (CList (x :<| _, _, _)) = x
-peek (CList (Empty, ys, zs)) = peek (CList (ys, Empty, zs))
-
-yankR :: Int -> CircularList a -> CircularList a
-yankR n = go . dropR' n
-  where
-    go :: (Seq a, CircularList a) -> CircularList a
-    go (zs, CList (xs, ys, _)) = CList (xs, ys, zs)
-
-putR :: CircularList a -> CircularList a
-putR (CList (xs, ys, zs)) = insertMany zs (CList (xs, ys, Empty))
-
-sortBy :: Eq a => (a -> a -> Ordering) -> CircularList a -> CircularList a
-sortBy fn (CList (xs, ys, zs)) = CList (Seq.sortBy fn (a :<| as), Empty, zs) & skipWhileR (/= a)
-  where
-    (a :<| as) = xs >< ys
-
-sort :: (Eq a, Ord a) => CircularList a -> CircularList a
-sort = sortBy compare
-
-when :: (p -> Bool) -> (p -> p) -> p -> p
-when p fn target = if p target then fn target else target
diff --git a/src/Day23/Solution.hs b/src/Day23/Solution.hs
index 88138ae..cf1441e 100644
--- a/src/Day23/Solution.hs
+++ b/src/Day23/Solution.hs
@@ -1,33 +1,72 @@
 module Day23.Solution where
 
-import Advent.Utils
-import Day23.CircularList
+import Advent.Utils (readInt)
+import Data.Bifunctor (Bifunctor (first))
+import qualified Data.IntMap.Lazy as IntMap
 
 part1 :: String -> String
-part1 = cupOrder . moves 100 . parseCircularList
+part1 = cupOrder . moves 100 . fromList . parseInts
 
 part2 :: String -> String
-part2 = head . lines
+part2 = show . product . adjacentTo 1 . moves (10 * oneMillion) . fillCups . parseInts
 
-parseCircularList :: String -> CircularList Int
-parseCircularList = fromList . map (readInt . pure) . head . lines
+oneMillion :: Int
+oneMillion = 1000000
 
-move :: CircularList Int -> CircularList Int
-move = putAtDestination . skipL 1 . yankR 3 . skipR 1
-  where
-    putAtDestination cl =
-      let current = peek cl
-          destination = (peek . skipL 1 . sort) cl
-       in skipR 1 . skipWhileR (/= current) . putR . skipR 1 . skipWhileR (/= destination) $ cl
+type CircularList = (Int, IntMap.IntMap Int)
 
-moves :: Int -> CircularList Int -> CircularList Int
+moves :: Int -> CircularList -> CircularList
 moves n
   | n < 0 = undefined
   | n == 0 = id
   | otherwise = moves (pred n) . move
 
-cupOrder :: CircularList Int -> String
-cupOrder = concatMap show . tail . toList . skipWhileR (/= 1)
+move :: CircularList -> CircularList
+move xss@(pointer, xs) = (d, (IntMap.insert c cNext . IntMap.insert destination a . IntMap.insert pointer d) xs)
+  where
+    [a, b, c, d] = take 4 . drop 1 . toList $ xss
+    cNext = xs ! destination
+    destination = findDestination (pred pointer)
+
+    findDestination candidate
+      | candidate == 0 = (findDestination . maximum . IntMap.keys) xs
+      | candidate `elem` [a, b, c] = findDestination (pred candidate)
+      | otherwise = candidate
+
+fromList :: [Int] -> CircularList
+fromList xss@(x : xs) = (x, IntMap.fromList (zip xss (xs ++ [x])))
+fromList _ = undefined
+
+toUniqList :: CircularList -> [Int]
+toUniqList = takeWhileUniq . toList
+  where
+    takeWhileUniq :: Eq a => [a] -> [a]
+    takeWhileUniq = foldr (\x r -> x : takeWhile (/= x) r) []
+
+toList :: CircularList -> [Int]
+toList = map fst . iterate next
+  where
+    next :: CircularList -> CircularList
+    next (pointer, cl) = (cl ! pointer, cl)
+
+(!) :: IntMap.IntMap Int -> Int -> Int
+m ! k = IntMap.findWithDefault (succ k) k m
+
+parseInts :: String -> [Int]
+parseInts = map (readInt . pure) . head . lines
+
+cupOrder :: CircularList -> String
+cupOrder = concatMap show . tail . toUniqList . first (const 1)
+
+fillCups :: [Int] -> CircularList
+fillCups xs = (pointer, (IntMap.insert oneMillion pointer . IntMap.insert lastKey (succ maxKey)) xs')
+  where
+    (pointer, xs') = fromList xs
+    maxKey = maximum xs
+    lastKey = last xs
+
+goTo :: Int -> CircularList -> CircularList
+goTo n = first (const n)
 
-fillCups :: [Int] -> [Int]
-fillCups xs = xs ++ [(maximum xs + 1) .. 1000000]
+adjacentTo :: Int -> CircularList -> [Int]
+adjacentTo n = take 2 . drop 1 . toList . goTo n
diff --git a/test/Day23/CircularListSpec.hs b/test/Day23/CircularListSpec.hs
deleted file mode 100644
index 033653b..0000000
--- a/test/Day23/CircularListSpec.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-module Day23.CircularListSpec (spec) where
-
-import Control.Exception
-import Data.Function
-import Data.Sequence (Seq (..))
-import qualified Data.Sequence as Seq
-import Day23.CircularList
-import Test.Hspec
-
-spec :: Spec
-spec = parallel $ do
-  let exampleList = [3, 8, 9, 1, 2, 5, 4, 6, 7] :: [Int]
-  let exampleCList = fromList exampleList
-
-  describe "fromList" $ do
-    it "creates a circular list" $ do
-      fromList exampleList `shouldBe` CList (Seq.fromList exampleList, Empty, Empty)
-
-  describe "toList" $ do
-    it "creates a list from a circular list" $ do
-      toList exampleCList `shouldBe` exampleList
-
-  describe "show" $ do
-    it "shows each element in the list" $ do
-      show exampleCList `shouldBe` "fromList [3,8,9,1,2,5,4,6,7]"
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 3 & show) `shouldBe` "fromList [1,2,5,4,6,7,3,8,9]"
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & skipR (-2)) `shouldThrow` anyException
-
-  describe "takeR" $ do
-    it "takes elements from the list" $ do
-      (exampleCList & takeR 3) `shouldBe` [3, 8, 9]
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 7 & takeR 3) `shouldBe` [6, 7, 3]
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & takeR (-2)) `shouldThrow` anyException
-
-  describe "dropR" $ do
-    it "drops elements from the list" $ do
-      (exampleCList & dropR 3) `shouldBe` fromList [1, 2, 5, 4, 6, 7]
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 7 & dropR 3) `shouldBe` fromList [8, 9, 1, 2, 5, 4]
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & dropR (-2)) `shouldThrow` anyException
-
-  describe "dropR'" $ do
-    it "it returns the dropped elements" $ do
-      (exampleCList & dropR' 3) `shouldBe` (Seq.fromList [3, 8, 9], fromList [1, 2, 5, 4, 6, 7])
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 7 & dropR' 3) `shouldBe` (Seq.fromList [6, 7, 3], fromList [8, 9, 1, 2, 5, 4])
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & dropR' (-2)) `shouldThrow` anyException
-
-  describe "skipR" $ do
-    it "skips elements on the list without removing them" $ do
-      (exampleCList & skipR 3) `shouldBe` fromList [1, 2, 5, 4, 6, 7, 3, 8, 9]
-    it "wraps the circular part" $ do
-      (exampleCList & skipR (3 + length exampleList)) `shouldBe` fromList [1, 2, 5, 4, 6, 7, 3, 8, 9]
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & skipR (-2)) `shouldThrow` anyException
-
-  describe "skipL" $ do
-    it "skips elements on the list without removing them" $ do
-      (exampleCList & skipL 3) `shouldBe` fromList [4, 6, 7, 3, 8, 9, 1, 2, 5]
-    it "wraps the circular part" $ do
-      (exampleCList & skipL (3 + length exampleList)) `shouldBe` fromList [4, 6, 7, 3, 8, 9, 1, 2, 5]
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & skipL (-2)) `shouldThrow` anyException
-
-  describe "skipWhileR" $ do
-    it "skips elements on the list without removing them" $ do
-      (exampleCList & skipWhileR (/= 1)) `shouldBe` fromList [1, 2, 5, 4, 6, 7, 3, 8, 9]
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 3 & skipWhileR (/= 3)) `shouldBe` exampleCList
-
-  describe "cons" $ do
-    it "inserts a value at the current position" $ do
-      (exampleCList & cons 13) `shouldBe` fromList [13, 3, 8, 9, 1, 2, 5, 4, 6, 7]
-    it "wraps the circular part" $ do
-      (exampleCList & skipL 1 & cons 13) `shouldBe` fromList [13, 7, 3, 8, 9, 1, 2, 5, 4, 6]
-
-  describe "insertMany" $ do
-    it "inserts a value at the current position" $ do
-      (exampleCList & insertMany [13, 17, 19]) `shouldBe` fromList [13, 17, 19, 3, 8, 9, 1, 2, 5, 4, 6, 7]
-    it "wraps the circular part" $ do
-      (exampleCList & skipL 1 & insertMany [13, 17, 19]) `shouldBe` fromList [13, 17, 19, 7, 3, 8, 9, 1, 2, 5, 4, 6]
-
-  describe "peek" $ do
-    it "shows the current value" $ do
-      (exampleCList & peek) `shouldBe` 3
-
-  describe "yankR" $ do
-    it "cuts elements from the list" $ do
-      (exampleCList & yankR 3) `shouldBe` fromList [1, 2, 5, 4, 6, 7]
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 7 & yankR 3) `shouldBe` fromList [8, 9, 1, 2, 5, 4]
-    it "is an error when n is negative" $ do
-      evaluate (exampleCList & yankR (-3)) `shouldThrow` anyException
-
-  describe "putR" $ do
-    it "is an identity" $ do
-      (exampleCList & putR) `shouldBe` exampleCList
-    it "is the duel of a yankR" $ do
-      (exampleCList & yankR 3 & putR) `shouldBe` exampleCList
-    it "wraps the circular part" $ do
-      (exampleCList & skipR 7 & yankR 3 & putR) `shouldBe` fromList [6, 7, 3, 8, 9, 1, 2, 5, 4]
-    it "lift and shift sections of the list" $ do
-      (exampleCList & skipR 1 & yankR 3 & skipR 1 & putR) `shouldBe` fromList [8, 9, 1, 5, 4, 6, 7, 3, 2]
-
-  describe "sortBy" $ do
-    it "sorts elements" $ do
-      {- HLINT ignore "Use sort" -}
-      (exampleCList & sortBy compare) `shouldBe` fromList [3, 4, 5, 6, 7, 8, 9, 1, 2]
-    it "sorts elements" $ do
-      (exampleCList & sort) `shouldBe` fromList [3, 4, 5, 6, 7, 8, 9, 1, 2]
-    it "sorts elements in reverse" $ do
-      (exampleCList & sortBy (flip compare)) `shouldBe` fromList [3, 2, 1, 9, 8, 7, 6, 5, 4]
diff --git a/test/Day23/SolutionSpec.hs b/test/Day23/SolutionSpec.hs
index 97d2611..b6058fa 100644
--- a/test/Day23/SolutionSpec.hs
+++ b/test/Day23/SolutionSpec.hs
@@ -1,7 +1,7 @@
 module Day23.SolutionSpec (spec) where
 
 import Data.Foldable (for_)
-import Day23.CircularList
+import qualified Data.IntMap.Lazy as IntMap
 import Day23.Solution
 import Test.Hspec
 
@@ -11,14 +11,22 @@ spec = parallel $ do
     input <- readFile "./test/Day23/input.txt"
     part1 input `shouldBe` "98752463"
 
-  xit "solves Part 2" $ do
+  it "solves Part 2" $ do
+    pendingWith "takes about 2 minutes to run"
+
     input <- readFile "./test/Day23/input.txt"
-    part2 input `shouldBe` "hello_santa"
+    part2 input `shouldBe` "2000455861"
+
+  let exampleCircularList = fromList [3, 8, 9, 1, 2, 5, 4, 6, 7]
+  describe "fromList" $ do
+    it "creates a circular list" $ do
+      exampleCircularList `shouldBe` (3, IntMap.fromList [(3, 8), (8, 9), (9, 1), (1, 2), (2, 5), (5, 4), (4, 6), (6, 7), (7, 3)])
 
-  let exampleCList = fromList [3, 8, 9, 1, 2, 5, 4, 6, 7]
-  describe "parseCircularList" $ do
-    it "reads a list of int characters" $ do
-      parseCircularList "389125467" `shouldBe` exampleCList
+  describe "toUniqList" $ do
+    it "creates a flat list" $ do
+      toUniqList exampleCircularList `shouldBe` [3, 8, 9, 1, 2, 5, 4, 6, 7]
+    it "can be wrapped" $ do
+      (toUniqList . goTo 1) exampleCircularList `shouldBe` [1, 2, 5, 4, 6, 7, 3, 8, 9]
 
   describe "moves" $ do
     let cases =
@@ -34,20 +42,25 @@ spec = parallel $ do
             (10, [8, 3, 7, 4, 1, 9, 2, 6, 5])
           ]
     let test (input, expected) = it ("walks through move " ++ show input) $ do
-          (toList . moves input) exampleCList `shouldBe` expected
+          (toUniqList . moves input) exampleCircularList `shouldBe` expected
 
     for_ cases test
 
   describe "cupOrder" $ do
     it "is 92658374 after 10 moves" $ do
-      (cupOrder . moves 10) exampleCList `shouldBe` "92658374"
-    it "is 92658374 after 100 moves" $ do
-      (cupOrder . moves 100) exampleCList `shouldBe` "67384529"
+      (cupOrder . moves 10) exampleCircularList `shouldBe` "92658374"
+    it "is 67384529 after 100 moves" $ do
+      (cupOrder . moves 100) exampleCircularList `shouldBe` "67384529"
+
+  let exampleCircularListFilled = fillCups [3, 8, 9, 1, 2, 5, 4, 6, 7]
 
   describe "fillCups" $ do
-    it "creats a million cups" $ do
-      length (fillCups [3, 8, 9, 1, 2, 5, 4, 6, 7]) `shouldBe` length [1 :: Int .. 1000000]
+    it "creates a million cups" $ do
+      exampleCircularListFilled `shouldBe` (3, IntMap.fromList [(3, 8), (8, 9), (9, 1), (1, 2), (2, 5), (5, 4), (4, 6), (6, 7), (7, 10), (oneMillion, 3)])
+
+  describe "adjacentTo" $ do
+    context "when running 10 000 000 rounds" $ do
+      it "get's the pair next to 1" $ do
+        pendingWith "takes about 2 minutes to run"
 
-  context "when running 10 000 000 rounds" $ do
-    it "works" $ do
-      (takeR 2 . skipR 1 . skipWhileR (/= 1) . moves 1 . fromList . fillCups) [3, 8, 9, 1, 2, 5, 4, 6, 7] `shouldBe` [934001, 159792]
+        (adjacentTo 1 . moves (10 * oneMillion)) exampleCircularListFilled `shouldBe` [934001, 159792]

From 3d2b5f46868845eb987f5afdc2cfbd6a5b58228d Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sun, 10 Jan 2021 09:54:37 -0800
Subject: [PATCH 6/7] Cleanup solution

---
 src/Day23/Solution.hs      | 30 +++++++++++++++++++++---------
 test/Day23/SolutionSpec.hs | 37 +++++++++++++++++++++++++++++++++----
 2 files changed, 54 insertions(+), 13 deletions(-)

diff --git a/src/Day23/Solution.hs b/src/Day23/Solution.hs
index cf1441e..f88bbd3 100644
--- a/src/Day23/Solution.hs
+++ b/src/Day23/Solution.hs
@@ -22,32 +22,41 @@ moves n
   | otherwise = moves (pred n) . move
 
 move :: CircularList -> CircularList
-move xss@(pointer, xs) = (d, (IntMap.insert c cNext . IntMap.insert destination a . IntMap.insert pointer d) xs)
+move xss@(pointer, xs) =
+  ( d,
+    (IntMap.insert c c' . IntMap.insert destination a . IntMap.insert pointer d) xs
+  )
   where
     [a, b, c, d] = take 4 . drop 1 . toList $ xss
-    cNext = xs ! destination
+    c' = xs ! destination
     destination = findDestination (pred pointer)
 
     findDestination candidate
+      | candidate < 0 = undefined
       | candidate == 0 = (findDestination . maximum . IntMap.keys) xs
       | candidate `elem` [a, b, c] = findDestination (pred candidate)
       | otherwise = candidate
 
 fromList :: [Int] -> CircularList
-fromList xss@(x : xs) = (x, IntMap.fromList (zip xss (xs ++ [x])))
+fromList xss@(x : xs) =
+  ( x,
+    IntMap.fromList (zip xss (xs ++ [x]))
+  )
 fromList _ = undefined
 
 toUniqList :: CircularList -> [Int]
 toUniqList = takeWhileUniq . toList
   where
     takeWhileUniq :: Eq a => [a] -> [a]
-    takeWhileUniq = foldr (\x r -> x : takeWhile (/= x) r) []
+    takeWhileUniq = foldr go []
+      where
+        go x r = x : takeWhile (/= x) r
 
 toList :: CircularList -> [Int]
-toList = map fst . iterate next
+toList = map fst . iterate go
   where
-    next :: CircularList -> CircularList
-    next (pointer, cl) = (cl ! pointer, cl)
+    go :: CircularList -> CircularList
+    go (pointer, cl) = (cl ! pointer, cl)
 
 (!) :: IntMap.IntMap Int -> Int -> Int
 m ! k = IntMap.findWithDefault (succ k) k m
@@ -56,10 +65,13 @@ parseInts :: String -> [Int]
 parseInts = map (readInt . pure) . head . lines
 
 cupOrder :: CircularList -> String
-cupOrder = concatMap show . tail . toUniqList . first (const 1)
+cupOrder = concatMap show . tail . toUniqList . goTo 1
 
 fillCups :: [Int] -> CircularList
-fillCups xs = (pointer, (IntMap.insert oneMillion pointer . IntMap.insert lastKey (succ maxKey)) xs')
+fillCups xs =
+  ( pointer,
+    (IntMap.insert oneMillion pointer . IntMap.insert lastKey (succ maxKey)) xs'
+  )
   where
     (pointer, xs') = fromList xs
     maxKey = maximum xs
diff --git a/test/Day23/SolutionSpec.hs b/test/Day23/SolutionSpec.hs
index b6058fa..660c3a5 100644
--- a/test/Day23/SolutionSpec.hs
+++ b/test/Day23/SolutionSpec.hs
@@ -12,7 +12,7 @@ spec = parallel $ do
     part1 input `shouldBe` "98752463"
 
   it "solves Part 2" $ do
-    pendingWith "takes about 2 minutes to run"
+    pendingWith "takes about 105 seconds to run"
 
     input <- readFile "./test/Day23/input.txt"
     part2 input `shouldBe` "2000455861"
@@ -20,7 +20,21 @@ spec = parallel $ do
   let exampleCircularList = fromList [3, 8, 9, 1, 2, 5, 4, 6, 7]
   describe "fromList" $ do
     it "creates a circular list" $ do
-      exampleCircularList `shouldBe` (3, IntMap.fromList [(3, 8), (8, 9), (9, 1), (1, 2), (2, 5), (5, 4), (4, 6), (6, 7), (7, 3)])
+      let expected =
+            ( 3,
+              IntMap.fromList
+                [ (3, 8),
+                  (8, 9),
+                  (9, 1),
+                  (1, 2),
+                  (2, 5),
+                  (5, 4),
+                  (4, 6),
+                  (6, 7),
+                  (7, 3)
+                ]
+            )
+      exampleCircularList `shouldBe` expected
 
   describe "toUniqList" $ do
     it "creates a flat list" $ do
@@ -56,11 +70,26 @@ spec = parallel $ do
 
   describe "fillCups" $ do
     it "creates a million cups" $ do
-      exampleCircularListFilled `shouldBe` (3, IntMap.fromList [(3, 8), (8, 9), (9, 1), (1, 2), (2, 5), (5, 4), (4, 6), (6, 7), (7, 10), (oneMillion, 3)])
+      let expected =
+            ( 3,
+              IntMap.fromList
+                [ (3, 8),
+                  (8, 9),
+                  (9, 1),
+                  (1, 2),
+                  (2, 5),
+                  (5, 4),
+                  (4, 6),
+                  (6, 7),
+                  (7, 10),
+                  (oneMillion, 3)
+                ]
+            )
+      exampleCircularListFilled `shouldBe` expected
 
   describe "adjacentTo" $ do
     context "when running 10 000 000 rounds" $ do
       it "get's the pair next to 1" $ do
-        pendingWith "takes about 2 minutes to run"
+        pendingWith "takes too long to run"
 
         (adjacentTo 1 . moves (10 * oneMillion)) exampleCircularListFilled `shouldBe` [934001, 159792]

From b468f8243c501940d0029abd7220e387a331016c Mon Sep 17 00:00:00 2001
From: Manu Phatak <manu@phatak.io>
Date: Sun, 10 Jan 2021 12:47:10 -0800
Subject: [PATCH 7/7] rm mtl

---
 AdventOfCode2020.cabal | 2 --
 package.yaml           | 1 -
 2 files changed, 3 deletions(-)

diff --git a/AdventOfCode2020.cabal b/AdventOfCode2020.cabal
index 9f6756e..4b9a083 100644
--- a/AdventOfCode2020.cabal
+++ b/AdventOfCode2020.cabal
@@ -67,7 +67,6 @@ library
   build-depends:
       base >=4.7 && <5
     , containers
-    , mtl
     , parsec
   default-language: Haskell2010
 
@@ -119,6 +118,5 @@ test-suite AdventOfCode2020-test
     , hspec
     , hspec-discover
     , hspec-golden
-    , mtl
     , parsec
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index 606c65a..3bdf34c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -23,7 +23,6 @@ dependencies:
 - base >= 4.7 && < 5
 - parsec
 - containers
-- mtl
 
 library:
   source-dirs: src