--{-# 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)
