matsuri-0.0.3: UI.hs

{-# LANGUAGE RecordWildCards #-}

-- | UI.hs
-- User interface.
module UI (
    UIState(..),
    mkUI,
    mkListBox,
    defaultUI,
    resizeUI
) where

import Buffers
import Config
import qualified Widgets.ListBox as L
import qualified Widgets.EditBox as E
import Widgets.PrettyBorders
import Widgets.TextBox

import Graphics.Vty
import Graphics.Vty.Widgets.All
import qualified Data.Map as M
import Data.Maybe
import Data.List


data UIState
  = UIState
    { roster :: L.ListBox
    , textBox :: TextBox
    , edit :: E.EditBox
    }


mkUI :: UIState -> Config -> Buffers -> Box
mkUI (UIState {..}) config buffers =
  (if null $ getCF "show_roster" config
       then tb <--> text def_attr ""
       else roster{L.listWidth=size} <++> pVBorder def_attr <++> tb)
  <--> text (back blue) "info"
  <--> edit
  where
    tb = case getBuf (L.cur roster) buffers of
        BufAccount acc -> mkTextBox (accContents acc) config
        BufChat chat -> mkTextBox (chatContents chat) config
        BufRoom room -> mkTextBox (roomContents room) config
        _ -> mkTextBox [] config
    size = read $ getCF "roster_width" config


mkTextBox :: [Content] -> Config -> TextBox
mkTextBox cnts config = TextBox $ map cnt2line cnts
  where
    -- todo: read colors from config
    cnt2line (Msg msg) = (def_attr, msg)
    cnt2line (MyMsg msg) = (fore yellow, msg)
    cnt2line (HistoryMsg msg) = (fore cyan, msg)
    cnt2line (InfoMsg msg) = (fore cyan, msg)


mkListBox :: L.ListBox -> Buffers -> L.ListBox
mkListBox roster buffers =
  roster { L.items = items
         , L.selectedIndex = newIndex }
  where
      -- new index
      newIndex = if L.selectedIndex roster < length items
                 then L.selectedIndex roster
                 else 0
      -- all items
      items = concat $ map mkAcc accs
      -- accounts
      accs = [ buf | buf@(BufAccount _) <- M.elems buffers ]
      ---
      mkAcc buf@(BufAccount acc)
        = (show buf, accName acc):
          (if accCollapsed acc
              then []
              else concat $ map (mkGroup (accName acc)) (groups acc))
      mkGroup k buf@(BufGroup grp)
        = (show buf, grpName grp):
          (if grpCollapsed grp
              then []
              else map mkChat $ grpBufs $ grpItems grp)
      mkChat buf@(BufChat chat)
        = (show buf, chatName chat)
      mkChat buf@(BufRoom room)
        = (show buf, roomName room)
      -- get acc groups
      groups acc = [ buf | buf@(BufGroup _) <- els ]
        where els = M.elems
                  $ M.filterWithKey (filt (accName acc++"|")) buffers
      filt prefix k _ = prefix `isPrefixOf` k
      -- get group chats
      grpBufs = catMaybes . map (flip M.lookup buffers)


defaultUI :: Buffers -> UIState
defaultUI buffers
  = UIState { roster = mkListBox L.empty buffers
            , textBox = TextBox []
            , edit = E.defaultEditBox
            }

resizeUI w _ ui@(UIState{..}) = ui {edit = E.resize w edit}

---
fore = (def_attr `with_fore_color`)
back = (def_attr `with_back_color`)