matsuri-0.0.3: Buffers.hs

-- | 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
        mark (Just occ') = roomBrackets occ' 'C' True
        mark _           = " [C]"
        occ = M.lookup (roomNick room) (roomOccupants room)

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 ++ jid
      where
        br = roomBrackets occ 'o' False
        nick | null br   = occNick occ
             | otherwise = " " ++ occNick occ
        jid = maybe "" (\j -> " ["++j++"]") (occJid occ)
-- | Draw room brackets (<>, {} or []).
roomBrackets :: Occupant
             -> Char -- ^ char between the brackets (C, o, a, etc)
             -> Bool -- ^ draw or not default status ([o])
             -> String
roomBrackets occ s always =
    role++(aff (occAffiliation occ))
  where
    role = role' (occRole occ)
    role' RModerator    = "+"
    role' RVisitor      = "-"
    role' _ | always    = " "
            | otherwise = ""
    ---
    aff AOwner = '<':s:'>':[]
    aff AAdmin = '{':s:'}':[]
    aff _ | always || (not $ null role) = '[':s:']':[]
          | otherwise                 = ""
-- | Draw all room occupants (like /names in irssi).
showOccupants :: [Occupant] -> Int -> String
showOccupants occs w =
    "Names:\n"++
    (intercalate "\n" $ map concat $ chunk row occs')
  where
    occs' = map drawOcc occs
    drawOcc occ
      = (take' (len-1) ' ' $ roomBrackets occ 'o' True
                           ++ " " ++ occNick occ)
        ++ " "
    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

data Group = Group
    { grpName :: String
    , grpCollapsed :: Bool
    , 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 :: M.Map String Occupant
    }

-- | New contents goes at top for more eaiser insert.
data Content = Msg String
             | MyMsg String
             | HistoryMsg String
             | InfoMsg String

-- | Event which pushed/popped from/to MVar.
data MEvent = VtyEvent Event
            | InsBuffer Key Buffer
            | NewMsg Key Content
            | NewRoomMsg Key (Maybe String, String, Maybe String)
            | NewStatus Key Status
            | RoomPresence REvent String Occupant Content

-- | Room presence type.
data REvent = Join
            | Leave


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)