Linting, haddocking

src/Dodge/Layout/Tree/Shift.hs

@@ -1,3 +1,8 @@
+{- |
+Given a tree of rooms, tries to shift them into place in such a way that their
+links connect and that none of them clip.
+Returns a list; after this step the structure is determined by the actual positions of rooms.
+ -}
 module Dodge.Layout.Tree.Shift
     where
 import Dodge.Room.Data
@@ -11,21 +16,13 @@ import Data.List (delete)
 import Data.Maybe (listToMaybe)
 import Control.Lens hiding (Empty, (<|) , (|>))
 
-shiftRoomTreeConstruct :: [[Point2]] -> Tree Room -> Maybe (Tree Room)
-shiftRoomTreeConstruct bs (Node t ts)
-    | roomIsClipping = Nothing
-    | otherwise = case children of
-        Nothing -> Nothing
-        Just ts' -> Just $ Node t ts'
-  where
-    roomIsClipping = any (polysIntersect (_rmBound t)) bs
-    children = sequence 
-             $ zipWith (\l -> shiftRoomTreeConstruct (_rmBound t : bs) 
-                                    . applyToRoot (shiftRoomToLink l))
-                       (_rmLinks t)
-                       ts
-
-shiftRoomTreeSearch :: [[Point2]] -> Seq (Tree Room) -> Maybe [Room]
+{- |
+Helper: Depth first search of trees of rooms, maybe produces a list rooms that are not clipping.
+ -}
+shiftRoomTreeSearch 
+    :: [[Point2]]       -- ^ Clipping bounds
+    -> Seq (Tree Room)  -- ^ Rooms to be added
+    -> Maybe [Room]
 shiftRoomTreeSearch _  Empty = Just []
 shiftRoomTreeSearch bs (Node r ts :<| ts')
     | roomIsClipping = Nothing
@@ -36,13 +33,18 @@ shiftRoomTreeSearch bs (Node r ts :<| ts')
     children = fromList $ zipWith (\l -> applyToRoot (shiftRoomToLink l))
                        (_rmLinks r)
                        ts
-
-shiftRoomTreeSearchAll :: [[Point2]] -> Seq (Tree Room) -> [[Room]]
+{- |
+All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.
+ -}
+shiftRoomTreeSearchAll 
+    :: [[Point2]]       -- ^ Clipping bounds
+    -> Seq (Tree Room)  -- ^ Rooms to be added
+    -> [[Room]]
 shiftRoomTreeSearchAll _ Empty = [[]]
 shiftRoomTreeSearchAll bs (Node r ts :<| ts')
     | roomIsClipping = [] -- this is called too often, but whatever
     | otherwise = case ts of
-        [] -> (r :) <$> (shiftRoomTreeSearchAll newBounds $ ts')
+        [] -> (r :) <$> (shiftRoomTreeSearchAll newBounds ts')
         (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
   where
     ls = init $ _rmLinks r
@@ -50,6 +52,8 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
     roomIsClipping = any (polysOverlap (_rmBound r)) bs
     rm l = r & rmLinks %~ delete l
     f l = applyToRoot (shiftRoomToLink l)
-
+{- |
+Depth first search of trees of rooms, maybe produces a list rooms that are not clipping.
+ -}
 shiftExpandTree :: Tree Room -> Maybe [Room]
 shiftExpandTree = listToMaybe . shiftRoomTreeSearchAll [] . singleton