32 lines
812 B
Haskell
32 lines
812 B
Haskell
--{-# 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)
|