Refactor

src/Dodge/Layout/Tree/Annotate.hs

@@ -76,7 +76,7 @@ annoToRoomTree [DoorNumAno i,AirlockAno] = airlock i >>=  roomThenCorridor
 annoToRoomTree [FirstWeapon] = do
     branchWP <- branchRectWith weaponRoom
     blockedC <- longBlockedCorridor
-    join $ takeOne $ (return $ appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
+    join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
 annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
 annoToRoomTree [StartRoom] = do
     w <- state $ randomR (100,400)
@@ -85,7 +85,7 @@ annoToRoomTree [StartRoom] = do
 annoToRoomTree (SpecificRoom rt:_) = rt
 annoToRoomTree (BossAno cr : _) = do
     br <- bossRoom cr
-    branchRectWith . pure . fmap (Left) $ treeFromPost [corridor,corridor] br
+    branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br
 annoToRoomTree (TreasureAno crs loot : _) =
     branchRectWith . fmap (pure . Left) $ lootRoom crs loot
 annoToRoomTree _ = do

src/Dodge/Layout/Tree/Shift.hs

@@ -26,13 +26,11 @@ shiftRoomTreeSearch
 shiftRoomTreeSearch _  Empty = Just []
 shiftRoomTreeSearch bs (Node r ts :<| ts')
     | roomIsClipping = Nothing
-    | otherwise = fmap (r :) $ shiftRoomTreeSearch newBounds $ ts' >< children
+    | otherwise = fmap (r :) . shiftRoomTreeSearch newBounds $ ts' >< children
   where
     roomIsClipping = or (polysIntersect <$> _rmBound r <*> bs)
     newBounds = _rmBound r ++ bs
-    children = fromList $ zipWith (\l -> applyToRoot (shiftRoomToLink l))
-                       (_rmLinks r)
-                       ts
+    children = fromList $ zipWith (applyToRoot . shiftRoomToLink) (_rmLinks r) ts
 {- |
 All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.
  -}
@@ -44,7 +42,7 @@ 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