74 lines
1.8 KiB
Haskell
74 lines
1.8 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,
|
|
MonadIO m
|
|
) =>
|
|
RoomsData ->
|
|
m (RoomsData, RoomsData)
|
|
roomStateDiffInOpenRooms newData = do
|
|
current <- getRoomDataState
|
|
|
|
liftIO $ putStrLn $ pack $ "Current rooms: " ++ show current
|
|
liftIO $ putStrLn $ pack $ "New rooms: " ++ show newData
|
|
let newRooms = filter roomNotEmpty $ filter (\newRoom -> isNothing $ find (sameName newRoom) (filter roomNotEmpty current)) newData
|
|
let oldRooms = filter roomNotEmpty $ filter (\oldRoom -> isNothing $ find (sameName oldRoom) newData) current
|
|
|
|
return (newRooms, oldRooms)
|
|
|
|
eqIgnoreOrdering :: (Eq a) => [a] -> [a] -> Bool
|
|
eqIgnoreOrdering a b = length a == length b && all (`elem` b) a
|