-- | Buffers.hs -- A module with defenition of buffer structures (structures which -- contain text and info about opened rooms and privates). module Buffers where import Utils import Network.XMPP import Network.XMPP.MUC import Control.Concurrent (ThreadId) import Graphics.Vty (Event) import qualified Data.Map as M import Data.List import Data.List.Split import Data.Maybe type Buffers = M.Map Key Buffer type Key = String data Buffer = BufAccount Account | BufChat Chat | BufGroup Group | BufRoom Room | BufUnknown -- ^ fallback buffer -- show instances instance Show Buffer where show (BufAccount acc) = case connection acc of OK _ _ -> c:" [o] "++accName acc NoConnection -> c:" [_] "++accName acc Trying -> c:" [!] "++accName acc where c = if accCollapsed acc then '+' else '-' show (BufGroup grp) = coll++name (grpName grp) where coll = if grpCollapsed grp then " +++ " else " --- " show (BufChat chat) = " ["++(show $ status chat)++ "] "++(itemJid $ item chat) show (BufRoom room) = " "++mark occ++" "++name (roomName room) where -- replace +{o} to +{C} fix (c:_:cs) = (reverse cs)++"C"++[c] -- do conf mark (+{C}, -[C], +, etc) mark (Just occ') = fix $ reverse $ roomBrackets occ' True mark _ = " [C]" occ = M.lookup (roomNick room) (roomOccupants room) -- tmp name = drop 1 . dropWhile (/='|') instance Show Status where show (Status StatusOnline _) = "o" show (Status StatusAway _) = "a" show (Status StatusChat _) = "c" show (Status StatusDND _) = "d" show (Status StatusXA _) = "n" show (Status StatusOffline _) = "_" instance Show Occupant where show occ = br ++ nick where br = roomBrackets occ False nick | null br = occNick occ | otherwise = " " ++ occNick occ -- | Draw room brackets (<>, {} or []). roomBrackets :: Occupant -> Bool -- ^ draw or not default status ([o]) -> String roomBrackets occ always = role++(aff (occAffiliation occ)) where role = role' (occRole occ) role' RModerator = "+" role' RVisitor = "-" role' _ | always = " " | otherwise = "" --- s = head $ show (occStatus occ) --- aff AOwner = '<':s:'>':[] aff AAdmin = '{':s:'}':[] aff _ | always || (not $ null role) = '[':s:']':[] | otherwise = "" -- | Draw all room occupants (like /names in irssi). showOccupants :: Occupants -> Int -> String showOccupants occs w = "Names:\n"++ (intercalate "\n" $ map concat $ chunk row occs') where occs' = map drawOcc (M.elems occs) drawOcc occ = (take' (len-1) ' ' $ roomBrackets occ True ++ " " ++ occNick occ) ++ " " row = (w - offset) `div` len len = 23 offset = 9 -- | Show room list (like /names, using many columns). showRoomList :: [(String, Maybe String)] -> Int -> String showRoomList list w = "List:\n"++ (intercalate "\n" $ map concat $ chunk row list') where list' = map drawElem list drawElem (l, _) = take' (len-1) ' ' l ++ " " row = (w - offset) `div` len len = 23 offset = 9 -- GDAT data Account = Account { accName :: String , username :: String , server :: String , password :: String , resource :: String , priority :: Integer , defaultNick :: String , connection :: Connection , accCollapsed :: Bool , accContents :: [Content] } data Connection = OK TCPConnection ThreadId | NoConnection | Trying -- TODO: check for connection? getC :: Account -> TCPConnection getC acc = let OK c _ = connection acc in c data Group = Group { grpName :: String , grpCollapsed :: Bool , grpContents :: [Content] , grpItems :: [String] } data Chat = Chat { item :: RosterItem , status :: Status , chatName :: String , chatContents :: [Content] } data Room = Room { roomName :: String , roomContents :: [Content] , roomNick :: String , roomSubject :: String , roomOccupants :: Occupants } type Occupants = M.Map String Occupant -- | New contents goes at top for more eaiser insert. data Content = Msg String | MyMsg String | HistoryMsg String | InfoMsg String | ErrorMsg String -- | Event which pushed/popped from/to MVar. data MEvent = VtyEvent Event | InsBuffer Key Buffer | NewMsg Key Content | NewStatus Key Status | NewRoomMsg Key (String, String, Maybe String, String, Bool) | RoomPresence Key (GroupchatPresence, Occupant) | RoomList Key [(String, Maybe String)] insElem :: Key -> Buffer -> Buffers -> Buffers insElem k = M.insert k getAcc :: Key -> Buffers -> Account getAcc k buffers = case M.lookup k buffers of Just (BufAccount acc) -> acc getBuf :: Key -> Buffers -> Buffer getBuf k buffers = case M.lookup k buffers of Just buf -> buf _ -> BufUnknown isBuf :: Key -> Buffers -> Bool isBuf k = isJust . M.lookup k -- | Kill room should run leaveGroupchat killBuffers :: String -> Buffers -> Buffers killBuffers startswith = M.filterWithKey (\k _ -> not $ startswith `isPrefixOf` k)