-- 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 ExistentialQuantification, RankNTypes, DeriveDataTypeable, NoMonomorphismRestriction, FlexibleContexts, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Manatee.Core.PageView where

import Control.Concurrent.STM 
import Control.Exception
import Control.Monad
import DBus.Client hiding (Signal)
import DBus.Message
import DBus.Types
import Manatee.Core.DBus
import Manatee.Core.Interactive
import Manatee.Core.Types
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.String
import Graphics.UI.Gtk.General.General

import qualified Data.Map as M

-- | PageViewKeymap.
pageViewKeymap :: PageViewKeymap
pageViewKeymap = 
    M.fromList
         [("M-u",        pageViewScrollStepUp)
         ,("M-i",        pageViewScrollStepDown)
         ,("M-U",        pageViewScrollPageUp)
         ,("M-I",        pageViewScrollPageDown)
         ,("C-I",        pageViewScrollToTop)
         ,("C-U",        pageViewScrollToBottom)
         ,("PageDown",   pageViewScrollPageUp)
         ,("PageUp",     pageViewScrollPageDown)
         ,("Home",       pageViewScrollToTop)
         ,("End",        pageViewScrollToBottom)
         ,("M-y",        pageViewScrollStepRight)
         ,("M-o",        pageViewScrollStepLeft)
         ,("M-Y",        pageViewScrollPageRight)
         ,("M-O",        pageViewScrollPageLeft)
         ,("C-Y",        pageViewScrollToLeft)
         ,("C-O",        pageViewScrollToRight)
         ,("M-x",        pageViewCutAction)
         ,("M-c",        pageViewCopyAction)
         ,("M-v",        pageViewPasteAction)
         ]

-- | Basic scroll action.
pageViewScrollStepUp, pageViewScrollStepDown, pageViewScrollPageUp, pageViewScrollPageDown :: PageView a => a -> IO ()
pageViewScrollStepUp   = pageViewScrollVerticalStep True 
pageViewScrollStepDown = pageViewScrollVerticalStep False 
pageViewScrollPageUp   = pageViewScrollVerticalPage True 
pageViewScrollPageDown = pageViewScrollVerticalPage False 

pageViewScrollStepRight, pageViewScrollStepLeft, pageViewScrollPageRight, pageViewScrollPageLeft :: PageView a => a -> IO ()
pageViewScrollStepRight = pageViewScrollHorizontalStep False
pageViewScrollStepLeft  = pageViewScrollHorizontalStep True
pageViewScrollPageRight = pageViewScrollHorizontalPage False
pageViewScrollPageLeft  = pageViewScrollHorizontalPage True

-- | Get plug id of page view.
pageViewGetPlugId :: forall a . PageView a => a -> IO PagePlugId
pageViewGetPlugId = readTVarIO . pageViewPlugId

-- | Update output.
pageViewUpdateOutputStatus :: forall a . PageView a => a -> String -> Maybe Int -> IO ()
pageViewUpdateOutputStatus view output limit = do
  plugId <- pageViewGetPlugId view
  let str = case limit of 
              Just l -> stripFormat output l
              Nothing -> output
  mkDaemonSignal (pageViewClient view)
                 LocalOutputbarUpdate 
                 (LocalOutputbarUpdateArgs plugId str)

-- | Update progress.
pageViewUpdateProgressStatus :: forall a . PageView a => a -> Double -> IO ()    
pageViewUpdateProgressStatus view progress = do
  plugId <- pageViewGetPlugId view
  mkDaemonSignal (pageViewClient view)
                 LocalProgressUpdate
                 (LocalProgressUpdateArgs plugId progress)


-- | Update status.
pageViewUpdateInfoStatus :: forall a . PageView a => a -> String -> String -> IO ()
pageViewUpdateInfoStatus view item status = do
  plugId <- pageViewGetPlugId view
  mkDaemonSignal (pageViewClient view)
                 LocalStatusbarUpdate 
                 (LocalStatusbarUpdateArgs plugId item status)

-- | Get dbus client.
pageViewClient :: forall a . PageView a => a -> Client
pageViewClient view = 
    case pageViewBuffer view of
      (PageBufferWrap b) -> pageBufferClient b

-- | Cut action.
pageViewCutAction :: forall a . PageView a => a -> IO ()
pageViewCutAction view = 
    unlessM (pageViewCut view) $
            pageViewUpdateOutputStatus view "Haven't implement pageViewCut" Nothing

-- | Copy action.
pageViewCopyAction :: forall a . PageView a => a -> IO ()
pageViewCopyAction view = 
    unlessM (pageViewCopy view) $
            pageViewUpdateOutputStatus view "Haven't implement pageViewCopy" Nothing

-- | Paste action.
pageViewPasteAction :: forall a . PageView a => a -> IO ()
pageViewPasteAction view = 
    unlessM (pageViewPaste view) $
            pageViewUpdateOutputStatus view "Haven't implement pageViewPaste" Nothing

-- | Call local interactive.
localInteractive :: forall a . PageView a => a -> String -> ([String] -> IO ()) -> IO ()
localInteractive view args action = 
  case parseInteractiveString args of
    -- Don't do anything if parse failed.
    Left err -> putStrLn $ "localInteractive : Failed with reason : " ++ show err
    Right strList -> do
      plugId <- pageViewGetPlugId view
      callDaemonMethodAsync 
          (pageViewClient view) 
          "Interactive" 
          [toVariant (plugId, args)]
          (\ err -> putStrLn $ "localInteractive : Failed with reason : " ++ show err)
          (\ methodReturn -> do
             let variants = messageBody methodReturn
             unless (null variants) $
                 (fromVariant (head variants) :: Maybe [String])
                 ?>= \ list -> 
                     -- Just do action if return list match.
                     when (length strList == length list) $ 
                          -- Use `postGUIAsync` to protected GTK+ main thread.
                          postGUIAsync (bracketOnError 
                                        (return list) 
                                        -- Print error message if exception rasied when do action.
                                        (\ _ -> putStrLn "localInteractive: exception rasied.")
                                        action))