feat(2017.06-haskell): solve Part One

VERSION

@@ -1 +1 @@
-2023.6.2.16
+2023.6.2.17

input/2017/day06.txt

@@ -0,0 +1 @@
+2	8	8	5	4	2	3	1	5	5	1	2	15	13	5	14

package.yaml

@@ -214,6 +214,9 @@ executables:
     dependencies:
       - extra
       - zippers
+  aoc-2017-day06:
+    <<: *executable
+    main: AdventOfCode.Year2017.Day06
   aoc-2018-day01:
     <<: *executable
     main: AdventOfCode.Year2018.Day01

src/AdventOfCode/Year2017/Day06.hs

@@ -0,0 +1,50 @@
+module AdventOfCode.Year2017.Day06 where
+
+import AdventOfCode.Input (parseInput)
+import AdventOfCode.TH (defaultMain, inputFilePath)
+import Data.Foldable (maximumBy)
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Data.List (foldl', unfoldr)
+import qualified Data.Set as Set
+import Text.Trifecta (natural, some)
+
+main :: IO ()
+main = $(defaultMain)
+
+partOne :: IntMap Int -> Int
+partOne = (+ 1) . length . unfoldr go . ((,) =<< Set.singleton)
+  where
+    go (seen, before)
+      | Set.member after seen = Nothing
+      | otherwise = Just (seen', (seen', after))
+      where
+        after = step before
+        seen' = Set.insert after seen
+
+partTwo :: IntMap Int -> Int
+partTwo = undefined
+
+getInput :: IO (IntMap Int)
+getInput = parseInput parser $(inputFilePath)
+  where
+    parser = IntMap.fromList . zip [0 ..] <$> some (fromInteger <$> natural)
+
+example :: IntMap Int
+example = IntMap.fromList (zip [0 ..] [0, 2, 7, 0])
+
+step :: IntMap Int -> IntMap Int
+step im =
+  foldl' go (IntMap.insert k 0 im) $
+    take v (drop (k + 1) (cycle [0 .. IntMap.size im - 1]))
+  where
+    go im' i = IntMap.update (Just . (+ 1)) i im'
+    (k, v) = next im
+
+next :: IntMap Int -> (Int, Int)
+next = maximumBy comparingValue . IntMap.assocs
+  where
+    comparingValue (k, v) (k', v') =
+      case compare v v' of
+        EQ -> compare k' k
+        ordering -> ordering