WIP: 2024-06

data/Y2024/D06/example

@@ -0,0 +1,10 @@
+....#.....
+.........#
+..........
+..#.......
+.......#..
+..........
+.#..^.....
+........#.
+#.........
+......#...

src/AoC/Util.hs

@@ -1,5 +1,8 @@
 -- | Internal module in order to facilitate testability.
-module AoC.Util (solveRiddle, readFileUtf8) where
+module AoC.Util (solveRiddle, readFileUtf8, module A, mkMatrix, Matrix) where
+
+import Data.Array (Array)
+import Data.Array qualified as A
 
 readFileUtf8 :: (MonadIO m) => FilePath -> m Text
 readFileUtf8 = fmap (decodeUtf8With lenientDecode) . readFileBS
@@ -9,3 +12,19 @@ solveRiddle file solver = do
   results <- solver <$> readFileUtf8 file
   forM_ (results `zip` [1 :: Int ..]) $ \(solution, part) ->
     putTextLn $ "  solution to part-" <> show part <> ": " <> solution
+
+type Matrix a = Array (Int, Int) a
+
+mkMatrix :: [[a]] -> Matrix a
+mkMatrix vss =
+  A.array
+    ((1, 1), (w, h))
+    [ ((x, y), v)
+    | (y, vs) <- zip [1 ..] vss
+    , (x, v) <- zip [1 ..] vs
+    ]
+ where
+  w = case vss of
+    [] -> 0
+    (vs : _) -> length vs
+  h = length vss

src/AoC/Y2024/D06.hs

@@ -1,6 +1,101 @@
+{-# LANGUAGE LambdaCase #-}
+{- HLINT ignore "Use bimapF" -}
+{-# LANGUAGE RecordWildCards #-}
+
 module AoC.Y2024.D06 (solve) where
 
 import AoC.Riddle
+import AoC.Util
+
+import Data.Array qualified as A
+
+-- import Data.Set qualified as S
+
+import Data.String (lines)
+import Prelude hiding (lines)
+
+data Direction
+  = U
+  | R
+  | D
+  | L
+  deriving stock (Show, Eq, Enum)
+
+data Tile
+  = Free
+  | Obstruction
+  | Visited
+  | Guard Direction
+  deriving stock (Show, Eq)
+
+type Position = (Int, Int)
+
+directionToVector :: Direction -> Position
+directionToVector = \case
+  U -> (0, -1)
+  R -> (1, 0)
+  D -> (0, 1)
+  L -> (-1, 0)
+
+parseTile :: Char -> Maybe Tile
+parseTile = \case
+  '.' -> pure Free
+  '#' -> pure Obstruction
+  '^' -> pure $ Guard U
+  '>' -> pure $ Guard R
+  'v' -> pure $ Guard D
+  '<' -> pure $ Guard L
+  _ -> Nothing
+
+data MapState where
+  MapState ::
+    { labMap :: Matrix Tile
+    , guardPosition :: Maybe (Position, Direction)
+    } ->
+    MapState
+  deriving stock (Show)
+
+parseMap :: Riddle -> Maybe (Matrix Tile)
+parseMap riddle = do
+  let
+    vss :: [[Char]]
+    vss = lines . toString $ riddle
+
+    vss' :: [Maybe [Tile]]
+    vss' = mapM parseTile <$> vss
+
+  mkMatrix <$> sequence vss'
+
+locateGuard :: Matrix Tile -> Maybe (Position, Direction)
+locateGuard = lookupGuard . fmap swap . A.assocs
+ where
+  lookupGuard :: [(Tile, Position)] -> Maybe (Position, Direction)
+  lookupGuard = getFirst . foldMap checkGuard
+
+  checkGuard :: (Tile, Position) -> First (Position, Direction)
+  checkGuard (Guard d, pos) = pure (pos, d)
+  checkGuard _ = mempty
+
+parse :: Riddle -> Maybe MapState
+parse riddle = do
+  labMap <- parseMap riddle
+  pure $ MapState{labMap, guardPosition = locateGuard labMap}
+
+movePosition :: Position -> Direction -> Position
+movePosition (x, y) d =
+  let (dx, dy) = directionToVector d
+   in (x + dx, y + dy)
+
+moveGuard :: MapState -> Maybe (Position, MapState)
+moveGuard MapState{..} = do
+  (pos, d) <- guardPosition
+  case d of {}
+
+part1 :: Riddle -> Maybe Int
+part1 riddle = Nothing
+
+part2 :: Riddle -> Maybe Int
+part2 riddle = Nothing
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve _ = pure $ Left "not yet implemented"
+solve riddle = pure $ Right [fromIntegral $ fromMaybe 0 (part1 riddle), fromIntegral $ fromMaybe 0 (part2 riddle)]