lets hack it to pieces

src/Floorplan.hs

@@ -6,7 +6,6 @@ import Data.Matrix (Matrix(..))
 import qualified Data.Matrix as M
 import qualified Data.Text as T
 import Data.Maybe
-import Data.List (intersect)
 
 import Linear (V2(..))
 
@@ -134,10 +133,6 @@ placeHalls rng fc input =
           else (g2, nmat)
         ) (rand, mat) bs
 
-boundSize :: Boundaries Int -> Int
-boundSize (Boundaries mi ma) =
-  (fst ma - fst mi) * (snd ma - snd mi)
-
 buildHall
   :: (V2 Int)
   -> Int
@@ -211,6 +206,7 @@ buildInnerWalls rng input =
                   doCross
                     g2
                     (cr, cc)
+                    coord
                     (Boundaries coord (maxRow, maxCol))
                     mat
                 else
@@ -224,13 +220,21 @@ buildInnerWalls rng input =
                           M.setElem (replaceTile (acc M.! coords) Offi) coords acc
                           ) mat btups
                     )
+          in  (nngen, nnmat)
+        | otherwise = (gn, mat)
+      tups mat = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]
+  in  foldl (\(agen, amat) cds -> floodSearchReplace agen cds amat)
+        (rng, input) (tups input)
+
 doCross
-                :: StdGen
+  :: RandomGen t
+  => t
+  -> (Int, Int)
   -> (Int, Int)
   -> Boundaries Int
   -> Matrix TileState
-                -> (StdGen, Matrix TileState)
+  -> (t, Matrix TileState)
-              doCross gen cd@(xr, xc) b imat =
+doCross gen cd@(xr, xc) coord@(row, col) b imat =
   let nbs = map (uncurry Boundaries) bs
       bs =
         [ (matmin b, cd)
@@ -261,18 +265,13 @@ buildInnerWalls rng input =
       btups = (,)
         <$> [fst (matmin b) .. fst (matmax b)]
         <*> [snd (matmin b) .. snd (matmax b)]
-                in if boundSize b >= 16
+  in if size b >= 16
      then foldl
-                     (\(agen, amat) (acr, nb) -> doCross agen acr nb amat)
+       (\(agen, amat) (acr, nb) -> doCross agen acr coord nb amat)
        (ngen, omat)
        (zip crosses nbs)
      else
        (gen, omat)
-          in  (nngen, nnmat)
-        | otherwise = (gn, mat)
-      tups mat = (,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]
-  in  foldl (\(agen, amat) cds -> floodSearchReplace agen cds amat)
-        (rng, input) (tups input)
 
 closeOffices :: Matrix TileState -> Matrix TileState
 closeOffices input =
@@ -423,16 +422,16 @@ assignClearance graph imat =
   foldM doAssignClearance [] graph
   where
     doAssignClearance acc (GHall conns) = do
-      ret <- GHall <$> foldM (\acc a -> do
+      ret <- GHall <$> foldM (\facc a -> do
-        res <- reassign True acc a
+        res <- reassign True facc a
-        return (acc ++ [res])
+        return (facc ++ [res])
         ) [] conns
       return (ret : acc)
     doAssignClearance acc room = do
       ret <- reassign False acc room
       return (acc ++ [ret])
     reassign :: Bool -> [Graph] -> Graph -> IO Graph
-    reassign p acc room@(GRoom ns b c t) =
+    reassign p acc room@(GRoom ns b _ _) =
       if p
       then do
         if actualRoomType b imat == Offi
@@ -440,7 +439,7 @@ assignClearance graph imat =
           let neigh = filter (all ((/= Hall) . snd) . neighbs) $
                 catMaybes
                   (map
-                    (\n -> findNeighbor n b imat onlyrooms)
+                    (\n -> findNeighbor n b onlyrooms)
                     nonhalls
                     )
               onlyrooms = tail graph
@@ -458,7 +457,7 @@ assignClearance graph imat =
           let neigh =
                 catMaybes
                   (map
-                    (\n -> findNeighbor n b imat onlyrooms)
+                    (\n -> findNeighbor n b onlyrooms)
                     nonhalls
                     )
               onlyrooms = connects (head acc)
@@ -490,8 +489,12 @@ doBoundedAssign g b = do
     { clearance = c
     }
 
-findNeighbor :: (GraphDirection, TileState) -> Boundaries Int -> M.Matrix TileState -> [Graph] -> Maybe Graph
+findNeighbor
-findNeighbor (dir, _) bnds imat ingraph
+  :: (GraphDirection, TileState)
+  -> Boundaries Int
+  -> [Graph]
+  -> Maybe Graph
+findNeighbor (dir, _) bnds ingraph
   | dir == North =
     let row = fst (matmin bnds) - 2
         col = snd (matmin bnds) + ((snd (matmax bnds) - snd (matmin bnds)) `div` 2)
@@ -509,14 +512,13 @@ findNeighbor (dir, _) bnds imat ingraph
         col = snd (matmin bnds) - 2
     in  postprocess row col
   where 
-    neighTile row col = imat M.! (row, col)
     postprocess row col =
       let filtered = filter
             (inBounds (V2 row col) . bounds)
             ingraph
       in
         case filtered of
-          [a@(GRoom _ _ _ ts)] -> Just a
+          [a@(GRoom _ _ _ _)] -> Just a
                                   -- if ts == neighTile row col
                                   -- then Just a
                                   -- else error "findNeighbor: Query Result does not match"