71 lines
1.7 KiB
Haskell
71 lines
1.7 KiB
Haskell
module State.RoomsState
|
|
( RoomsState,
|
|
initRoomsState,
|
|
HasRoomsState (..),
|
|
roomStateDiffers,
|
|
roomStateDiffInOpenRooms,
|
|
updateRoomState,
|
|
getRoomState,
|
|
)
|
|
where
|
|
|
|
import ClassyPrelude
|
|
import State.GenericTVarState
|
|
import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
|
|
import Types.RoomData (RoomsData, roomNotEmpty, sameName)
|
|
|
|
type RoomsState = GenericTVarState RoomsData
|
|
|
|
initRoomsState :: IO RoomsState
|
|
initRoomsState = newTVarIO []
|
|
|
|
class HasRoomsState a where
|
|
getRoomsState :: a -> RoomsState
|
|
|
|
updateRoomState ::
|
|
( HasRoomsState env,
|
|
MonadIO m,
|
|
MonadReader env m
|
|
) =>
|
|
RoomsData ->
|
|
m ()
|
|
updateRoomState newData = do
|
|
state <- getRoomsState <$> ask
|
|
liftIO $ putStrLn "Upating room state"
|
|
updateGenericTVarState state newData
|
|
liftIO $ putStrLn "Done Upating room state"
|
|
|
|
getRoomState ::
|
|
( HasRoomsState env,
|
|
MonadIO m,
|
|
MonadReader env m
|
|
) =>
|
|
m RoomsData
|
|
getRoomState = do
|
|
state <- getRoomsState <$> ask
|
|
getGenericTVarState state
|
|
|
|
roomStateDiffers ::
|
|
( MonadRoomDataStateRead m
|
|
) =>
|
|
RoomsData ->
|
|
m Bool
|
|
roomStateDiffers newData = do
|
|
not . eqIgnoreOrdering newData <$> getRoomDataState
|
|
|
|
roomStateDiffInOpenRooms ::
|
|
( MonadRoomDataStateRead m
|
|
) =>
|
|
RoomsData ->
|
|
m (RoomsData, RoomsData)
|
|
roomStateDiffInOpenRooms newData = do
|
|
current <- getRoomDataState
|
|
|
|
let newRooms = filter roomNotEmpty $ filter (\newRoom -> isNothing $ find (sameName newRoom) current) newData
|
|
let oldRooms = filter (\newRoom -> isJust $ find (sameName newRoom) current) newData
|
|
|
|
return (newRooms, oldRooms)
|
|
|
|
eqIgnoreOrdering :: (Eq a) => [a] -> [a] -> Bool
|
|
eqIgnoreOrdering a b = length a == length b && all (`elem` b) a
|