From b0a191edb973000d26b13210e07a2508a59123e0 Mon Sep 17 00:00:00 2001
From: George Thomas <georgefsthomas@gmail.com>
Date: Mon, 8 Dec 2025 21:58:47 +0000
Subject: [PATCH] Solve day 8 part 1

---
 haskell/Pre.hs          |  2 +-
 haskell/Puzzles/Day8.hs | 28 +++++++++++++++++++++++++---
 haskell/aoc.cabal       |  1 +
 outputs/real/8/1        |  1 +
 4 files changed, 28 insertions(+), 4 deletions(-)
 create mode 100644 outputs/real/8/1

diff --git a/haskell/Pre.hs b/haskell/Pre.hs
index 6ae7d50..3ed2811 100644
--- a/haskell/Pre.hs
+++ b/haskell/Pre.hs
@@ -57,7 +57,7 @@ import Data.Char
 import Data.Foldable hiding (foldl1, foldr1, maximum, maximumBy, minimum, minimumBy)
 import Data.Foldable1
 import Data.Functor
-import Data.List (sortOn, transpose)
+import Data.List (sortOn, tails, transpose)
 import Data.List.Extra (dropEnd, enumerate)
 import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1)
 import Data.Maybe
diff --git a/haskell/Puzzles/Day8.hs b/haskell/Puzzles/Day8.hs
index b52e740..caacb3a 100644
--- a/haskell/Puzzles/Day8.hs
+++ b/haskell/Puzzles/Day8.hs
@@ -2,14 +2,36 @@ module Puzzles.Day8 (puzzle) where
 
 import Pre
 
+import Data.DisjointSet qualified as DS
+import Data.Text.Lazy qualified as TL
+import Linear.Metric
+import Linear.V3
+
 puzzle :: Puzzle
 puzzle =
     Puzzle
         { number = 8
-        , parser = pure ()
+        , parser = (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
         , parts =
-            [ \() ->
-                "TODO"
+            [ TL.show
+                . product
+                . take 3
+                . sortOn Down
+                . map length
+                . DS.toLists
+                . snd
+                . \boxes ->
+                    -- TODO more principled way of distinguishing example and real
+                    (!! ((if length boxes == 20 then 10 else if length boxes == 1000 then 1000 else undefined))) $
+                        connectBoxes boxes
             ]
         , extraTests = mempty
         }
+
+connectBoxes :: [V3 Int] -> [((V3 Int, V3 Int), DS.DisjointSet (V3 Int))]
+connectBoxes boxes = zip allPairs $ scanl (flip $ uncurry DS.union) (foldMap DS.singleton boxes) allPairs
+  where
+    allPairs = sortOn (quadrance . uncurry (-)) $ filter (uncurry (/=)) $ allUnorderedPairs boxes
+
+allUnorderedPairs :: [a] -> [(a, a)]
+allUnorderedPairs = concat . join (zipWith (flip $ map . (,)) . tails)
diff --git a/haskell/aoc.cabal b/haskell/aoc.cabal
index 785832f..bacc80f 100644
--- a/haskell/aoc.cabal
+++ b/haskell/aoc.cabal
@@ -44,6 +44,7 @@ executable aoc
         containers,
         deepseq,
         directory,
+        disjoint-containers,
         exceptions,
         extra,
         filepath,
diff --git a/outputs/real/8/1 b/outputs/real/8/1
new file mode 100644
index 0000000..a5fc3eb
--- /dev/null
+++ b/outputs/real/8/1
@@ -0,0 +1 @@
+66640
\ No newline at end of file