module Kevin.Chatrooms ( removeRoom, addUser, setUsers, removeUser, removeUserAll, numUsers, setPrivclasses, getPrivclass, getPrivclassLevel, setUserPrivclass, setTitle ) where import Control.Applicative import Control.Lens import Data.List import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T import Kevin.Types deleteBy' :: (a -> Bool) -> [a] -> [a] deleteBy' f (x:xs) = if f x then xs else x:deleteBy' f xs deleteBy' _ [] = [] removeRoom :: Chatroom -> KevinIO () removeRoom c = kevin $ privclasses.at c .= Nothing >> users.at c .= Nothing addUser :: Chatroom -> User -> KevinIO () addUser ch us = kevin $ users.ix ch %= (us:) numUsers :: Chatroom -> T.Text -> KevinIO Int numUsers ch us = do st <- gets_ $ view users case st^.at ch of Just usrs -> return . length $ findIndices (\u -> us == username u) usrs Nothing -> return 0 removeUser :: Chatroom -> T.Text -> KevinIO () removeUser ch us = kevin $ users.ix ch %= deleteBy' ((== us) . username) removeUserAll :: Chatroom -> T.Text -> KevinIO () removeUserAll ch us = kevin $ users.ix ch %= filter ((/= us) . username) setUsers :: Chatroom -> [User] -> KevinIO () setUsers ch uss = kevin $ users.at ch ?= uss setPrivclasses :: Chatroom -> [Privclass] -> KevinIO () setPrivclasses room ps = kevin $ privclasses.at room ?= M.fromList ps getPrivclass :: Chatroom -> T.Text -> KevinIO (Maybe T.Text) getPrivclass room user = do st <- gets_ $ view users case st^.at room of Just qs -> return $ privclass <$> listToMaybe (filter ((== user) . username) qs) Nothing -> return Nothing getPrivclassLevel :: Chatroom -> T.Text -> KevinIO Int getPrivclassLevel room pc = do st <- gets_ $ view privclasses return . fromMaybe 0 $ st^.at room >>= (^.at pc) setUserPrivclass :: Chatroom -> T.Text -> T.Text -> KevinIO () setUserPrivclass room user pc = do pclevel <- getPrivclassLevel room pc kevin $ users.ix room.traverse.filtered ((user ==) . username) %= (\u -> u {privclass = pc, privclassLevel = pclevel}) setTitle :: Chatroom -> T.Text -> KevinIO () setTitle ch t = kevin $ titles.at ch ?= t