Linting, haddocking

src/Dodge/Layout/Tree/Annotate.hs

@@ -1,4 +1,4 @@
-{-
+{- |
 Annotating tree structures with desired properties for rooms.
 -}
 module Dodge.Layout.Tree.Annotate
@@ -43,38 +43,44 @@ addLock i t = do
     (beforeLock, afterLock) <- splitTrunk t
     newBefore <- applyToRandomNode (Key i :) beforeLock
     return $ addToTrunk newBefore [Node [Lock i] afterLock]
-
+{- |
+Add one corridor between each parent-child link of a tree of annotations.
+ -}
 padCorridors :: Tree [Annotation g] -> Tree [Annotation g]
 padCorridors (Node x xs) = Node [Corridor] [Node x (map padCorridors xs)]
-
+{-
+Add one to three corridors between each parent-child link of a tree of annotations.
+ -}
 randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
 randomPadCorridors  (Node x xs) = do
     n <- state $ randomR (1, 3)
     xs' <- mapM randomPadCorridors xs
     return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
-
+{- |
+Add a corridor to a random out-link of a room.
+ -}
 roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
 roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) 
                                 (randomiseOutLinks corridor)
-
-
+{- |
+Create a random room tree structure from a list of annotations.
+ -}
 annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
 annoToRoomTree [OrAno as] = do
     a <- takeOne as
     annoToRoomTree a
-annoToRoomTree [Corridor] = fmap (pure . Right) $ randomiseOutLinks corridor
+annoToRoomTree [Corridor] = pure . Right <$> randomiseOutLinks corridor
 annoToRoomTree [DoorAno] = roomThenCorridor door
 annoToRoomTree [DoorNumAno i,AirlockAno] = roomThenCorridor (airlock i)
 annoToRoomTree [FirstWeapon] = do
     branchWP <- branchRectWith weaponRoom
     blockedC <- longBlockedCorridor
-    firstWeapon <- takeOne $ [return $ appendEitherTree branchWP [blockedC]] ++ replicate 5 weaponRoom
-    firstWeapon
+    join $ takeOne $ (return $ appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
 annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
 annoToRoomTree [StartRoom] = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
-    fmap (pure . Right) $ randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
+    pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
 annoToRoomTree (SpecificRoom rt:_) = rt
 annoToRoomTree (BossAno cr : _) = branchRectWith . fmap (pure . Left) $ bossRoom cr
 annoToRoomTree (TreasureAno crs loot : _) =

src/Dodge/Layout/Tree/Either.hs

@@ -28,22 +28,20 @@ appendEitherTree
     :: Tree (Either a a)    -- ^ The first tree
     -> [Tree (Either a a)]    -- ^ The forest to append
     -> Tree (Either a a)
-appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (flip appendEitherTree ts') ts
+appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
 appendEitherTree (Node (Right x) ts) ts' = Node (Left x) ts'
 
 removeEither (Left y)  = y
 removeEither (Right y) = y
 
-{- 
+{-  |
 Make a singleton connection of an Either Tree.
 -}
 connectRoom :: a -> Tree (Either a a)
 connectRoom r = Node (Right r) [] 
 
-{-
+{- |
 Make a singleton dead end of an Either Tree.
 -}
 deadRoom :: a -> Tree (Either a a)
 deadRoom r = Node (Left r) []
-
-

src/Dodge/Layout/Tree/Polymorphic.hs

@@ -15,7 +15,7 @@ import Data.Tree
 import Control.Monad.State
 import System.Random
 
-{-
+{- |
 Creates a linear tree.
 Safe.
 -}
@@ -23,7 +23,7 @@ treeFromPost :: [a] -> a -> Tree a
 treeFromPost []     y = Node y []
 treeFromPost (x:xs) y = Node x [treeFromPost xs y]
 
-{-
+{- |
 Creates a tree with one trunk branch, 
 input as a list, that ends in another tree.
 -}
@@ -34,7 +34,7 @@ treeFromTrunk
 treeFromTrunk [] t     = t
 treeFromTrunk (x:xs) t = Node x [treeFromTrunk xs t]
 
-{-
+{- |
 Applies a function to the root of a tree.
 -}
 applyToRoot :: (a -> a) -> Tree a -> Tree a
@@ -42,7 +42,7 @@ applyToRoot f (Node t ts) = Node (f t) ts
 
 treeSize = length . flatten
 
-{-
+{- |
 Applies a function to a specific node determined by a list of indices.
 Unsafe (partial function).
 -}
@@ -52,7 +52,7 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
   where
     (ys, z:zs) = splitAt i xs
 
-{-
+{- |
 Applies a function to the first node along a trunk that satisfies a given property.
 -}
 applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
@@ -64,62 +64,65 @@ applyToSubTrunkBy _ _ t = t
 zipTree :: Tree a -> Tree b -> Tree (a,b)
 zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
 
-{-
+{- |
 Makes each node into its child number, i.e. the index it has 
 in the list of children of its parent.
 -}
 treeChildNums :: Tree a -> Tree Int
-treeChildNums t = setRoot 0 t
+treeChildNums = setRoot 0
   where 
     setRoot :: Int -> Tree a -> Tree Int
     setRoot i (Node x xs) = Node i (zipWith setRoot [0..] xs)
 
-{-
+{- |
 Makes each node into its path, i.e. the list of indices that, 
 when followed from the root, lead to the node.
 -}
 treePaths :: Tree a -> Tree [a]
-treePaths (Node x xs) = fmap (x :) $ Node [] (map treePaths xs)
+treePaths (Node x xs) = (x :) <$> Node [] (map treePaths xs)
 
-{-
+{- |
 Picks a random path in the tree.
 Uniform probability that the path leads to any specific node.
 -}
 randomPath :: RandomGen g => Tree a -> State g [Int]
 randomPath = takeOne . flatten . treePaths . treeChildNums
 
-{-
-Apply a function to a node picked uniformly at random.
+{- |
+Apply a function to the value of a node; 
+the node is picked uniformly at random.
 -}
 applyToRandomNode :: RandomGen g => (a -> a) -> Tree a -> State g (Tree a)
 applyToRandomNode f t = do
     p <- randomPath t
     return $ applyToNode p f t
 
-{-
+{- |
 Add a forest to the end of a tree (along the trunk).
 -}
 addToTrunk :: Tree a -> [Tree a] -> Tree a
 addToTrunk (Node x []) f = Node x f
 addToTrunk (Node x (t:ts)) f = Node x (addToTrunk t f : ts)
 
-{-
+{- |
 Find the depth of a tree along the trunk.
 -}
 trunkDepth :: Tree a -> Int
 trunkDepth (Node _ []) = 0
 trunkDepth (Node _ (x:xs)) = trunkDepth x + 1
 
-{-
+{- |
 Split a tree at a given point along its trunk.
 -}
-splitTrunkAt :: Int -> Tree a -> (Tree a, [Tree a])
+splitTrunkAt 
+    :: Int      -- ^ Split depth
+    -> Tree a -> (Tree a, [Tree a])
 splitTrunkAt 0 (Node x xs) = (Node x [],xs)
 splitTrunkAt i (Node y (x:xs)) = 
-    let (t, ts) = (splitTrunkAt (i-1) x)
-    in  (Node y (t : xs) , ts)
+    let (t, ts) = splitTrunkAt (i-1) x
+    in (Node y (t : xs) , ts)
 
-{-
+{- |
 Split a tree at a random point along its trunk.
 -}
 splitTrunk :: RandomGen g => Tree a -> State g (Tree a, [Tree a])

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