-- Author:     Andy Stewart <lazycat.manatee@gmail.com>
-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
-- 
-- Copyright (C) 2010 Andy Stewart, all rights reserved.
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Manatee.Extension.ProcessManager.ProcessView where

import Control.Applicative
import Control.Concurrent.STM 
import Control.Monad
import Data.List (findIndex)
import Data.Map (Map)
import Data.Text.Lazy (Text)
import Data.Typeable
import Graphics.UI.Gtk hiding (Statusbar, statusbarNew, get)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Manatee.Core.PageView
import Manatee.Core.Types
import Manatee.Extension.ProcessManager.ProcessBuffer
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.Functor
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.Process
import Manatee.Toolkit.General.STM
import Manatee.Toolkit.Gtk.Concurrent
import Manatee.Toolkit.Gtk.Gtk
import Manatee.Toolkit.Gtk.ModelView
import Manatee.Toolkit.Gtk.ScrolledWindow
import System.Linux.Proc

import qualified Data.Map as M

data ProcessView =
    ProcessView {processViewPlugId              :: TVar PagePlugId
                ,processViewScrolledWindow      :: ScrolledWindow
                ,processViewBuffer              :: ProcessBuffer
                ,processViewTreeView            :: TreeView
                ,processViewListStore           :: ListStore ProcStatus
                ,processViewSortModel           :: TypedTreeModelSort ProcStatus
                ,processViewBroadcastChannel    :: ViewChannel ProcTChanSignal
                }
    deriving Typeable

instance PageBuffer ProcessBuffer where
    pageBufferGetName           = return . processBufferName
    pageBufferSetName _ _       = return ()
    pageBufferClient            = processBufferClient
    pageBufferCreateView a pId  = PageViewWrap <$> processViewNew a pId
    pageBufferMode              = processBufferMode

instance PageView ProcessView where
    pageViewBuffer              = PageBufferWrap . processViewBuffer
    pageViewPlugId              = processViewPlugId
    pageViewFocus               = treeViewFocus . processViewTreeView
    pageViewScrolledWindow      = processViewScrolledWindow
    pageViewHandleKeyAction     = processViewHandleKeyAction
    pageViewScrollToTop         = processViewScrollToTop
    pageViewScrollToBottom      = processViewScrollToBottom
    pageViewScrollVerticalPage  = processViewScrollVerticalPage
    pageViewScrollVerticalStep  = processViewScrollVerticalStep

-- | Create process view.
processViewNew :: ProcessBuffer -> PagePlugId -> IO ProcessView
processViewNew buffer plugId = do
  -- Create plug id.
  pId <- newTVarIO plugId

  -- Create UI frame.
  scrolledWindow <- scrolledWindowNew_

  -- Tree view.
  treeView <- treeViewNew
  treeViewSetEnableTreeLines treeView True
  scrolledWindow `containerAdd` treeView

  -- List store.
  listStore <- listStoreNew []

  -- Sort model.
  sortModel <- treeModelSortNewWithModel listStore

  -- Channel.
  channel <- createViewChannel (processBufferBroadcastChannel buffer) treeView

  -- Process view.
  let processView = ProcessView pId scrolledWindow buffer treeView listStore sortModel channel

  -- Read channel.
  processViewListenChannel processView

  -- Tick view counter.
  counter <- tickTVarIO (processBufferViewCounter buffer)
  when (counter == 1) $ processBufferUpdate buffer
  treeView `onDestroy` do
    crockTVarIO (processBufferViewCounter buffer)
    return ()

  -- Draw view.
  processViewDraw processView

  return processView

-- | Listen broadcast channel for draw view synchronous.
processViewListenChannel :: ProcessView -> IO ()
processViewListenChannel view = 
    listenViewChannel (processViewBroadcastChannel view) $ \signal -> 
        case signal of
          KillProcess index -> 
              listStoreRemove (processViewListStore view) index
          UpdateProcesses -> do
              -- Get selected process id before update.
              pid <- 
                      treeViewGetSelectedValue (processViewTreeView view)
                                               (processViewSortModel view)
                                               (processViewListStore view)
                      >?>=> \info ->
                              return $ Just $ psProcessId info
              
              -- Update process view.
              processViewUpdate view
              
              -- Restore select path after update.
              pid ?>= \id -> do
                      list <- listStoreToList (processViewListStore view)
                      findIndex (\x -> psProcessId x == id) list ?>= \ i -> do
                          path <- treeModelSortConvertChildPathToPath (processViewSortModel view) [i]
                          treeViewSetCursor (processViewTreeView view) path Nothing
              
          _ -> return ()

-- | Draw process view.
processViewDraw :: ProcessView -> IO ()
processViewDraw view = do
  -- Get value.
  let buffer = processViewBuffer view
  fileInfos <- readTVarIO $ processBufferStatus buffer 
  let treeView  = processViewTreeView view
      store     = processViewListStore view
      model     = processViewSortModel view

  -- Append to list store.
  listStoreClear store
  forM_ fileInfos (listStoreAppend store) 

  -- Set tree view model.
  treeViewSetModel treeView model

  -- Clean tree view.
  treeViewRemoveColumns treeView

  -- Add column file info to tree view.
  forM_ (processBufferOptions buffer) (processViewAddColumn treeView store model)

  -- Sort column.
  sortStatus <- readTVarIO $ processBufferSortStatus buffer
  processViewSortInternal view sortStatus

  return ()

-- | Update process view.
processViewUpdate :: ProcessView -> IO ()
processViewUpdate view = do
  -- Get value.
  let store  = processViewListStore view
  fileInfos <- readTVarIO $ processBufferStatus $ processViewBuffer view

  -- Append to list store.
  listStoreClear store
  forM_ fileInfos (listStoreAppend store) 

  return ()

-- | Internal sort function.
processViewSortInternal :: ProcessView -> (ProcOption, SortType) -> IO ()
processViewSortInternal view (option, sortType) = do
  let options = processBufferOptions $ processViewBuffer view 
  lookup option options ?>= \x -> 
      treeSortableSetSortColumnId (processViewSortModel view) x sortType

-- | Add column.
processViewAddColumn :: (ProcStatusClass t,
                      TreeViewClass self1,
                      TreeModelClass self,
                      TreeModelSortClass self,
                      TypedTreeModelClass model,
                      TreeSortableClass self) =>
                     self1
                   -> model ProcStatus
                   -> self
                   -> (t, SortColumnId)
                   -> IO ()
processViewAddColumn treeView model sortModel option@(info,sortId) = do
  processViewSetSortFunc model sortModel option

  let name = getColumnTitle info
      maxWidth = getColumnMaxWidth info
  tvc <- treeViewAddColumnWithTitle treeView name sortId
  maxWidth ?>= \width -> treeViewColumnSetMaxWidth tvc width

  cell <- cellRendererTextNew
  treeViewColumnPackStart tvc cell True

  processViewSetCellText tvc cell model sortModel info

-- | Set sort function.
processViewSetSortFunc :: (TreeSortableClass self,
                        TypedTreeModelClass model,
                        ProcStatusClass a) =>
                       model ProcStatus
                     -> self
                     -> (a, SortColumnId)
                     -> IO ()
processViewSetSortFunc model sortModel (info, sortId) = 
  treeSortableSetSortFunc sortModel sortId $ \iter1 iter2 -> do
    row1 <- treeModelGetRow model iter1
    row2 <- treeModelGetRow model iter2
    compareRow info row1 row2

-- | Set cell text.
processViewSetCellText :: (CellLayoutClass self,
                        CellRendererTextClass cell,
                        TreeModelClass model,
                        TreeModelSortClass model,
                        TypedTreeModelClass model1,
                        ProcStatusClass a) =>
                       self
                     -> cell
                     -> model1 ProcStatus
                     -> model
                     -> a
                     -> IO ()
processViewSetCellText tvc cell model sortModel info = 
    cellLayoutSetAttributeFunc tvc cell sortModel $ \iter -> do
      row <- treeModelSortGetRow model sortModel iter
      set cell [cellText   := getCellText info row
               ,cellXAlign := getCellXAlign info]

-- | Handle keymap.
processViewHandleKeyAction :: ProcessView -> Text -> SerializedEvent -> IO ()  
processViewHandleKeyAction view keystoke sEvent = 
  case M.lookup keystoke processViewKeymap of
    Just action -> action view
    Nothing -> widgetPropagateEvent (processViewTreeView view) sEvent
                 
-- | Keymap.
processViewKeymap :: Map Text (ProcessView -> IO ())
processViewKeymap = 
    M.fromList
         [("j",         processViewNextNode)
         ,("k",         processViewPrevNode)
         ,("Down",      processViewNextNode)
         ,("Up",        processViewPrevNode)          
         ,("J",         processViewScrollToBottom)
         ,("K",         processViewScrollToTop)
         ,(" ",         processViewScrollVerticalPage True)
         ,("b",         processViewScrollVerticalPage False)
         ,("PageDown",  processViewScrollVerticalPage True)
         ,("PageUp",    processViewScrollVerticalPage False)
         ,(";",         processViewKillProcess)
         ,("1",         processViewSortByName)
         ,("2",         processViewSortByProcessId)
         ,("3",         processViewSortByUser)
         ,("4",         processViewSortByState)
         ,("5",         processViewSortByMemory)
         ,("6",         processViewSortByCPU)
         ,("7",         processViewSortByPriority)
         ,("8",         processViewSortByThreads)
         ,("9",         processViewSortByCmdline)
         ]

-- | Next node.
processViewNextNode :: ProcessView -> IO ()
processViewNextNode = treeViewFocusNextToplevelNode . processViewTreeView
    
-- | Previous node.
processViewPrevNode :: ProcessView -> IO ()    
processViewPrevNode = treeViewFocusPrevToplevelNode . processViewTreeView

-- | Scroll to top.
processViewScrollToTop :: ProcessView -> IO ()
processViewScrollToTop = 
    treeViewFocusFirstToplevelNode . processViewTreeView

-- | Scroll to bottom.
processViewScrollToBottom :: ProcessView -> IO ()
processViewScrollToBottom = 
    treeViewFocusLastToplevelNode . processViewTreeView 

-- | Scroll page vertically.
processViewScrollVerticalPage :: Bool -> ProcessView -> IO ()
processViewScrollVerticalPage isDown a = do
  let sw = processViewScrolledWindow a
      tv = processViewTreeView a
  pageInc <- (<=<) adjustmentGetPageIncrement scrolledWindowGetVAdjustment sw
  treeViewScrollVertical tv sw (if isDown then pageInc else (- pageInc))

-- | Scroll step vertically.
processViewScrollVerticalStep :: Bool -> ProcessView -> IO ()
processViewScrollVerticalStep isDown a = do
  let sw = processViewScrolledWindow a
      tv = processViewTreeView a
  stepInc <- (<<<=) integralToDouble treeViewGetSelectedCellHeight tv
  treeViewScrollVertical tv sw (if isDown then stepInc else (- stepInc))

-- | Sort by process name.
processViewSortByName :: ProcessView -> IO ()
processViewSortByName view = processViewSort view MCommand

-- | Sort by user.
processViewSortByUser :: ProcessView -> IO ()
processViewSortByUser view = processViewSort view MUser

-- | Sort by process id.
processViewSortByProcessId :: ProcessView -> IO ()
processViewSortByProcessId view = processViewSort view MProcessId

-- | Sort by process state.
processViewSortByState :: ProcessView -> IO ()
processViewSortByState view = processViewSort view MState

-- | Sort by parent process id.
processViewSortByParentId :: ProcessView -> IO ()
processViewSortByParentId view = processViewSort view MParentProcessId

-- | Sort by group id.
processViewSortByGroupId :: ProcessView -> IO ()
processViewSortByGroupId view = processViewSort view MProcessGroupId

-- | Sort by session id.
processViewSortBySessionId :: ProcessView -> IO ()
processViewSortBySessionId view = processViewSort view MSessionId

-- | Sort by priority.
processViewSortByPriority :: ProcessView -> IO ()
processViewSortByPriority view = processViewSort view MPriority

-- | Sort by child threads of process.
processViewSortByThreads :: ProcessView -> IO ()
processViewSortByThreads view = processViewSort view MThreads

-- | Sort by CPU percent.
processViewSortByCPU :: ProcessView -> IO ()
processViewSortByCPU view = processViewSort view MCPUPercent

-- | Sort by memory.
processViewSortByMemory :: ProcessView -> IO ()
processViewSortByMemory view = processViewSort view MResidentMemory

-- | Sort by command line.
processViewSortByCmdline :: ProcessView -> IO ()
processViewSortByCmdline view = processViewSort view MCmdline

-- | Sort column.
processViewSort :: ProcessView -> ProcOption -> IO ()
processViewSort view option = do
  -- Get model and options.
  let model   = processViewSortModel view 
      buffer  = processViewBuffer view
      options = processBufferOptions buffer
  -- Get current sortType and columnId.
  (curSortType, _, curSortColumnId) <- treeSortableGetSortColumnId model
  lookup option options ?>= \id -> do
    treeSortableSetSortColumnId model id $
      if id == curSortColumnId
         -- Just change sort order when sort column id is same.
         then 
             -- Just change sort order.
             case curSortType of
               SortAscending  -> SortDescending
               SortDescending -> SortAscending
         -- Otherwise sort ascending.
         else SortAscending

    -- Get new sort type.
    (newSortType, _, _) <- treeSortableGetSortColumnId model

    -- Update sort status of buffer.
    writeTVarIO (processBufferSortStatus $ processViewBuffer view) (option, newSortType)

    -- Focus to cell.
    treeViewFocus (processViewTreeView view)

-- | Kill process.
processViewKillProcess :: ProcessView -> IO ()
processViewKillProcess view = do
  let treeView = processViewTreeView view
  treeViewGetSelectedPath treeView
    >?>= \ path -> do
      -- Get process id.
      currentPath <- treeModelSortConvertPathToChildPath (processViewSortModel view) path
      info <- listStoreGetValue (processViewListStore view) (head currentPath)
      let processId = psProcessId info 
          processName = psCommand info

      -- Kill process.
      runCommand_ ("kill " ++ show processId)

      -- Remove process from view.
      processViewRemoveProcess view (head currentPath)

      -- Popup notify message.
      pageViewUpdateOutputStatus view ("Kill process '" ++ processName ++ "' (" ++ show processId ++ ")") Nothing
  
-- | Remove process from view.  
processViewRemoveProcess :: ProcessView -> Int -> IO ()
processViewRemoveProcess view index = 
    -- Write message to broadcast channel to update all view of current buffer.
    writeTChanIO (viewChannel $ processViewBroadcastChannel view) (KillProcess index)