diff --git a/src/Dodge/Cleat.hs b/src/Dodge/Cleat.hs
new file mode 100644
index 000000000..08b4befc3
--- /dev/null
+++ b/src/Dodge/Cleat.hs
@@ -0,0 +1,31 @@
+--{-# LANGUAGE TupleSections #-}
+module Dodge.Cleat 
+    ( toLabel
+    , cleatOnward
+    , cleatSide
+    , rToOnward
+    , cleatLabel
+    ) where
+import Dodge.Data
+import Dodge.Tree.Compose
+
+import Data.Tree
+import Control.Lens
+import qualified Data.Set as S
+
+toLabel :: Int -> Room -> Maybe Room
+toLabel i rm
+    | LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just rm
+    | otherwise = Nothing
+
+rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room String)
+rToOnward s t = return $ tToBTree s t
+
+cleatOnward :: Room -> Room
+cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
+
+cleatSide :: Room -> Room
+cleatSide = rmClusterStatus . csLinks . at SideCluster ?~ ()
+
+cleatLabel :: Int -> Room -> Room
+cleatLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)