Pending.hs

module Macbeth.Wx.Pending (
  wxPending
) where

import Macbeth.Fics.FicsMessage
import Macbeth.Fics.Api.PendingOffer
import Macbeth.Wx.Utils

import Control.Concurrent.STM
import Graphics.UI.WX
import Graphics.UI.WXCore
import System.IO


data PendingActions =
    PendingTo { accept :: MenuItem (), decline :: MenuItem ()}
  | PendingFrom { withdraw :: MenuItem () }


wxPending :: Handle -> Panel () -> IO (Panel (), FicsMessage -> IO ())
wxPending h p' = do
  p <- panel p' []
  stFrom <- staticText p [ text := "Offers from other players:", fontSize := 12]
  lcFrom  <- listCtrl p [ columns := [ ("#", AlignLeft, -1), ("offer", AlignLeft, -1)]]
  vPending <- newTVarIO ([] :: [PendingOffer])

  stTo <- staticText p [ text := "Offers to other players:", fontSize := 12]
  lcTo  <- listCtrl p [columns := [ ("#", AlignLeft, -1), ("offer", AlignLeft, -1)]]

  set p [ layout := column 5 [ hfill $ widget stFrom
                             , fill $ widget lcFrom
                             , hfill $ widget $ vspace 5
                             , hfill $ widget $ hrule 1
                             , hfill $ widget $ vspace 5
                             , hfill $ widget stTo
                             , fill $ widget lcTo]]

  listItemRightClickEvent lcFrom (ctxMenuHandler h lcFrom From)
  listItemRightClickEvent lcTo (ctxMenuHandler h lcTo To)

  let handler cmd = case cmd of

                Pending offer -> do
                  atomically $ modifyTVar vPending (++ [offer])
                  itemAppend (if isFrom offer then lcFrom else lcTo) (toList offer)

                PendingRemoved idx -> do
                  items <- atomically $ do
                    modifyTVar vPending $ filter ((/= idx) . offerId)
                    readTVar vPending
                  itemsDelete lcFrom
                  itemsDelete lcTo
                  mapM_ (itemAppend lcTo) (fmap toList (filter isTo items))
                  mapM_ (itemAppend lcFrom) (fmap toList (filter isFrom items))
                _ -> return ()

  return (p, handler)


toList :: PendingOffer -> [String]
toList (PendingOffer _ id _ _ params) = [show id, params]


ctxMenuHandler :: Handle -> ListCtrl () -> Origin -> Graphics.UI.WXCore.ListEvent () -> IO ()
ctxMenuHandler h listCtrl origin evt = do
  ctxMenu <- menuPane []
  idx <- listEventGetIndex evt
  offerId <- (head . (!! idx)) <$> get listCtrl items
  _ <- (if origin == To then menuPendingTo else menuPendingFrom) ctxMenu h offerId
  when (idx >= 0) $ listEventGetPoint evt >>= flip (menuPopup ctxMenu) listCtrl


menuPendingFrom :: Menu () -> Handle -> String -> IO PendingActions
menuPendingFrom ctxMenu h offerId = PendingTo
  <$> menuItem ctxMenu [ text := "Accept", on command := hPutStrLn h ("4 accept " ++ offerId)]
  <*> menuItem ctxMenu [ text := "Decline", on command := hPutStrLn h ("4 decline " ++ offerId)]


menuPendingTo :: Menu () -> Handle -> String -> IO PendingActions
menuPendingTo ctxMenu h offerId = PendingFrom
  <$> menuItem ctxMenu [ text := "Withdraw", on command := hPutStrLn h ("4 withdraw " ++ offerId)]