1 files changed, 111 insertions, 0 deletions
diff --git a/2022/22-Monkey-Map/first.hs b/2022/22-Monkey-Map/first.hs
new file mode 100644
index 0000000..a7f9385
--- /dev/null
+++ b/2022/22-Monkey-Map/first.hs
@@ -0,0 +1,111 @@
+-- requires cabal install --lib megaparsec parser-combinators vector
+module Main (main) where
+import Control.Monad (void, when)
+import Data.Functor
+import Data.List qualified as L
+import Data.Vector qualified as V
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Exit (die)
+
+exampleExpectedOutput = 6032
+
+type Line = V.Vector Char
+type Map = V.Vector Line
+data Instruction = Move Int | L | R deriving Show
+data Input = Input Map [Instruction] deriving Show
+
+type Parser = Parsec Void String
+
+parseMapLine :: Parser Line
+parseMapLine = do
+  line <- some (char '.' <|> char ' ' <|> char '#') <* char '\n'
+  return $ V.generate (length line) (line !!)
+
+parseMap :: Parser Map
+parseMap = do
+  lines <- some parseMapLine <* char '\n'
+  return $ V.generate (length lines) (lines !!)
+
+parseInstruction :: Parser Instruction
+parseInstruction = (Move . read <$> some digitChar)
+               <|> (char 'L' $> L)
+               <|> (char 'R' $> R)
+
+parseInput' :: Parser Input
+parseInput' = do
+  m <- parseMap
+  i <- some parseInstruction
+  void $ optional (char '\n') <* eof
+  return $ Input m i
+
+parseInput :: String -> IO Input
+parseInput filename = do
+  input <- readFile filename
+  case runParser parseInput' filename input of
+    Left bundle -> die $ errorBundlePretty bundle
+    Right input' -> return input'
+
+data Heading = N | S | E | W deriving Show
+data Cursor = Cursor Int Int Heading
+
+step :: Map -> Cursor -> Instruction -> Cursor
+step _ (Cursor x y N) L = Cursor x y W
+step _ (Cursor x y S) L = Cursor x y E
+step _ (Cursor x y E) L = Cursor x y N
+step _ (Cursor x y W) L = Cursor x y S
+step _ (Cursor x y N) R = Cursor x y E
+step _ (Cursor x y S) R = Cursor x y W
+step _ (Cursor x y E) R = Cursor x y S
+step _ (Cursor x y W) R = Cursor x y N
+step m c (Move 0) = c
+step m (Cursor x y h) (Move i) = case (m V.! y'') V.! x'' of
+  '.' -> step m (Cursor x'' y'' h) (Move $ i - 1)
+  _ -> Cursor x y h
+  where
+    (x', y') = case h of
+      N -> (x, y-1)
+      S -> (x, y+1)
+      E -> (x+1, y)
+      W -> (x-1, y)
+    line = m V.! y
+    xmax = length line - 1
+    xmin = length (V.filter (== ' ') line)
+    x'' | x' < xmin = xmax
+        | x' > xmax = xmin
+        | otherwise = x'
+    ymaxLookup :: Int -> Int
+    ymaxLookup ym = case (m V.! ym) V.!? x of
+      Just '.' -> ym
+      Just '#' -> ym
+      _ -> ymaxLookup $ ym - 1
+    yminLookup :: Int -> Int
+    yminLookup ym = case (m V.! ym) V.!? x of
+      Just ' ' -> yminLookup $ ym + 1
+      _ -> ym
+    ymax = ymaxLookup $ length m - 1
+    ymin = yminLookup 0
+    y'' | y' < ymin = ymax
+        | y' > ymax = ymin
+        | otherwise = y'
+
+compute :: Input -> Int
+compute (Input m i) = 1000 * (y+1) + 4 * (x+1) + hv
+  where
+    xmin = length (V.filter (== ' ') (m V.! 0))
+    startingCursor = Cursor xmin 0 E
+    Cursor x y h = L.foldl' (step m) startingCursor i
+    hv = case h of
+      E -> 0
+      S -> 1
+      W -> 2
+      N -> 3
+
+main :: IO ()
+main = do
+  example <- parseInput "example"
+  let exampleOutput = compute example
+  when  (exampleOutput /= exampleExpectedOutput)  (die $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
+  input <- parseInput "input"
+  print $ compute input