2 files changed, 60 insertions(+), 37 deletions(-)

M 2023/14.hs
A lib/Qulude/Grid.hs

@@ 7,6 7,9 @@ module Main where
 
 import Qulude
 
+import qualified Qulude.Grid as Grid
+import Qulude.Grid ( Grid(..), Pos )
+
 --import Data.Array ( (!) )
 import qualified Data.Array as Array
 import qualified Data.Array.ST as STArray


@@ 21,41 24,9 @@ import qualified Data.Set as Set
 data Rock = Round | Cube
   deriving ( Show, Eq, Ord )
 
-type Pos = (Int,Int)
-type Bounds = (Pos, Pos)
-
-data Grid a = Grid (Map.Map Pos a) Bounds
-  deriving ( Show, Eq, Ord )
-
-parseGrid :: Parser (Maybe a) -> Parser (Grid a)
-parseGrid p = do
-  raw <- rawP
-  let maxY = maximum $ fmap (\(y,_) -> y) raw
-      maxX = maximum $ fmap (\(_, xs) -> maximum $ fmap (\(x, _) -> x) xs) raw
-  return $ Grid (build raw) ((1,1), (maxX,maxY))
-  where rawP = fmap (zip [1..]) $ many1 $ zip [1..] <$> p `manyTill` newline
-        build = Map.fromList . concat . fmap f
-        f (y, xs) = catMaybes $ fmap (g y) xs
-        g y (_, Nothing) = Nothing
-        g y (x, Just a) = Just ((x,y), a)
-
-lookupGrid :: Grid a -> Pos -> Maybe a
-lookupGrid (Grid g _) p = Map.lookup p g
-
-inBounds :: Grid a -> Pos -> Bool
-inBounds (Grid _ ((minX, minY),(maxX, maxY))) (x,y) =
-  (minX <= x) && (x <= maxX) && (minY <= y) && (y <= maxY)
-
-bounds :: Grid a -> (Pos, Pos)
-bounds (Grid _ b) = b
-
-renderGrid :: Grid a -> (Maybe a -> Char) -> String
-renderGrid (Grid m ((minX, minY),(maxX, maxY))) r =
-  concat $ [[ r $ Map.lookup (x,y) m | x <-[minX..maxX] ] ++ "\n" | y <- [minY..maxY] ]
-
 type Parse = Grid Rock
 parser :: Parser Parse
-parser = parseGrid rock
+parser = Grid.parse rock
   where rock = char '.' $> Nothing
            <|> char '#' $> Just Cube
            <|> char 'O' $> Just Round


@@ 68,7 39,7 @@ roundRocks (Grid rs _) = Map.foldlWithKey f [] rs
 north :: Grid Rock -> Pos -> Pos
 north g (x,y) = (x, succ $ f 0 (pred y))
   where f acc 0 = acc
-        f acc y = case lookupGrid g (x,y) of
+        f acc y = case Grid.lookup g (x,y) of
                     Nothing -> f acc (pred y)
                     Just Cube -> y + acc
                     Just Round -> f (succ acc) (pred y)


@@ 76,7 47,7 @@ north g (x,y) = (x, succ $ f 0 (pred y))
 east :: Grid Rock -> Pos -> Pos
 east g@(Grid _ (_, (mX, _))) (x,y) = (pred $ f 0 (succ x), y)
   where f acc x | x > mX = succ $ mX - acc
-        f acc x | otherwise = case lookupGrid g (x,y) of
+        f acc x | otherwise = case Grid.lookup g (x,y) of
                     Nothing -> f acc (succ x)
                     Just Cube -> x - acc
                     Just Round -> f (succ acc) (succ x)


@@ 84,7 55,7 @@ east g@(Grid _ (_, (mX, _))) (x,y) = (pred $ f 0 (succ x), y)
 south :: Grid Rock -> Pos -> Pos
 south g@(Grid _ (_, (_, mY))) (x,y) = (x, pred $ f 0 (succ y))
   where f acc y | y > mY = succ $ mY - acc
-        f acc y | otherwise = case lookupGrid g (x,y) of
+        f acc y | otherwise = case Grid.lookup g (x,y) of
                     Nothing -> f acc (succ y)
                     Just Cube -> y - acc
                     Just Round -> f (succ acc) (succ y)


@@ 92,7 63,7 @@ south g@(Grid _ (_, (_, mY))) (x,y) = (x, pred $ f 0 (succ y))
 west :: Grid Rock -> Pos -> Pos
 west g (x,y) = (succ $ f 0 (pred x), y)
   where f acc 0 = acc
-        f acc x = case lookupGrid g (x,y) of
+        f acc x = case Grid.lookup g (x,y) of
                     Nothing -> f acc (pred x)
                     Just Cube -> x + acc
                     Just Round -> f (succ acc) (pred x)

@@ 0,0 1,52 @@
+module Qulude.Grid ( Grid(..)
+
+                   , bounds
+                   , inBounds
+
+                   , Pos
+                   , Bounds
+
+                   , lookup
+
+                   , parse
+                   , render
+                   ) where
+
+import Prelude hiding ( lookup )
+
+import qualified Data.Map as Map
+import Data.Maybe ( catMaybes )
+
+import Text.Parsec hiding ( parse )
+
+type Pos = (Int,Int)
+type Bounds = (Pos, Pos)
+
+data Grid a = Grid (Map.Map Pos a) Bounds
+  deriving ( Show, Eq, Ord )
+
+parse :: Stream s m Char => ParsecT s u m (Maybe a) -> ParsecT s u m (Grid a)
+parse p = do
+  raw <- rawP
+  let maxY = maximum $ fmap (\(y,_) -> y) raw
+      maxX = maximum $ fmap (\(_, xs) -> maximum $ fmap (\(x, _) -> x) xs) raw
+  return $ Grid (build raw) ((1,1), (maxX,maxY))
+  where rawP = fmap (zip [1..]) $ many1 $ zip [1..] <$> p `manyTill` newline
+        build = Map.fromList . concat . fmap f
+        f (y, xs) = catMaybes $ fmap (g y) xs
+        g y (_, Nothing) = Nothing
+        g y (x, Just a) = Just ((x,y), a)
+
+lookup :: Grid a -> Pos -> Maybe a
+lookup (Grid g _) p = Map.lookup p g
+
+inBounds :: Grid a -> Pos -> Bool
+inBounds (Grid _ ((minX, minY),(maxX, maxY))) (x,y) =
+  (minX <= x) && (x <= maxX) && (minY <= y) && (y <= maxY)
+
+bounds :: Grid a -> (Pos, Pos)
+bounds (Grid _ b) = b
+
+render :: Grid a -> (Maybe a -> Char) -> String
+render (Grid m ((minX, minY),(maxX, maxY))) r =
+  concat $ [[ r $ Map.lookup (x,y) m | x <-[minX..maxX] ] ++ "\n" | y <- [minY..maxY] ]