47 lines
1.3 KiB
Haskell
47 lines
1.3 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.UseAll
|
|
( toOnward'
|
|
, toLabel'
|
|
, cleatOnward
|
|
, cleatSide
|
|
, rToOnward
|
|
, cleatLabel
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Tree.Compose
|
|
import Dodge.Tree.Compose.Data
|
|
|
|
import Data.Tree
|
|
import Control.Lens
|
|
import qualified Data.Set as S
|
|
|
|
toOnward :: String -> Room -> Maybe ([String],Room)
|
|
toOnward s rm
|
|
| OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks
|
|
= Just ([s],rm & rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
|
|
| otherwise = Nothing
|
|
|
|
|
|
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)
|
|
rToOnward s t = return $ MTree s (tToBTree t) []
|
|
|
|
|
|
toClusterLabel :: Int -> String -> Room -> Maybe ([String],Room)
|
|
toClusterLabel i s rm
|
|
| LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just ([s],rm)
|
|
| otherwise = Nothing
|
|
|
|
cleatOnward :: Room -> Room
|
|
cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster
|
|
|
|
cleatSide :: Room -> Room
|
|
cleatSide = rmClusterStatus . csLinks .~ S.singleton SideCluster
|
|
|
|
cleatLabel :: Int -> Room -> Room
|
|
cleatLabel i = rmClusterStatus . csLinks .~ S.singleton (LabelCluster i)
|