matsuri-0.0.4: 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
        -- replace +{o} to +{C}
        fix (c:_:cs) = (reverse cs)++"C"++[c]
        -- do conf mark (+{C}, -[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)