{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  IDE.Pane.WebKit.Documentation
-- Copyright   :  2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie
-- License     :  GPL
--
-- Maintainer  :  maintainer@leksah.org
-- Stability   :  provisional
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module IDE.Pane.WebKit.Documentation (
    IDEDocumentation(..)
  , DocumentationState(..)
  , getDocumentation
  , loadDoc
  , reloadDoc
) where

import Graphics.UI.Frame.Panes
       (RecoverablePane(..), PanePath, RecoverablePane, Pane(..))
import Graphics.UI.Gtk
       (scrolledWindowSetShadowType, scrolledWindowSetPolicy,
        scrolledWindowNew, castToWidget, ScrolledWindow)
import Data.Typeable (Typeable)
import Data.Text (Text)
import IDE.Core.Types (IDEAction, IDEM)
import Control.Monad.IO.Class (MonadIO(..))
import Graphics.UI.Frame.ViewFrame (getNotebook)
import IDE.Core.State (reifyIDE)
import Graphics.UI.Gtk.General.Enums
       (ShadowType(..), PolicyType(..))

#ifdef WEBKITGTK
import Graphics.UI.Gtk
       (eventModifier, eventKeyName, keyPressEvent, focusInEvent,
        containerAdd, Modifier(..), after)
import Graphics.UI.Gtk.WebKit.Types (WebView(..))
import Graphics.UI.Gtk.WebKit.WebView
       (webViewUri, webViewGoBack, webViewZoomOut, webViewZoomIn,
        webViewZoomLevel, webViewReload, webViewLoadUri, webViewNew)
import System.Glib.Attributes (AttrOp(..), set, get)
import System.Glib.Signals (on)
import IDE.Core.State (reflectIDE)
import Graphics.UI.Editor.Basics (Connection(..))
#else
import Data.IORef (writeIORef, newIORef, readIORef, IORef)
import Control.Applicative ((<$>))
#endif

data IDEDocumentation = IDEDocumentation {
    scrolledView :: ScrolledWindow
#ifdef WEBKITGTK
  , webView      :: WebView
#else
  , docState     :: IORef DocumentationState
#endif
} deriving Typeable

data DocumentationState = DocumentationState {
    zoom :: Float
  , uri  :: Maybe Text
} deriving(Eq,Ord,Read,Show,Typeable)

instance Pane IDEDocumentation IDEM
    where
    primPaneName _  =   "Doc"
    getAddedIndex _ =   0
    getTopWidget    =   castToWidget . scrolledView
    paneId b        =   "*Doc"

instance RecoverablePane IDEDocumentation DocumentationState IDEM where
    saveState p     =   liftIO $
#ifdef WEBKITGTK
         do zoom <- webView p `get` webViewZoomLevel
            uri  <- webView p `get` webViewUri
            return (Just DocumentationState{..})
#else
            Just <$> readIORef (docState p)
#endif
    recoverState pp DocumentationState {..} =   do
        nb      <-  getNotebook pp
        mbPane <- buildPane pp nb builder
        case mbPane of
            Nothing -> return ()
            Just p  -> liftIO $
#ifdef WEBKITGTK
                 do webView p `set` [webViewZoomLevel := zoom]
                    maybe (return ()) (webViewLoadUri (webView p)) uri
#else
                    writeIORef (docState p) DocumentationState {..}
#endif
        return mbPane
    builder pp nb windows = reifyIDE $ \ ideR -> do
        scrolledView <- scrolledWindowNew Nothing Nothing
        scrolledWindowSetShadowType scrolledView ShadowIn

#ifdef WEBKITGTK
        webView <- webViewNew
        containerAdd scrolledView webView
#else
        docState <- newIORef DocumentationState {zoom = 1.0, uri = Nothing}
#endif

        scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic
        let docs = IDEDocumentation {..}

#ifdef WEBKITGTK
        cid1 <- after webView focusInEvent $ do
            liftIO $ reflectIDE (makeActive docs) ideR
            return True

        webView `set` [webViewZoomLevel := 2.0]
        cid2 <- webView `on` keyPressEvent $ do
            key <- eventKeyName
            mod <- eventModifier
            liftIO $ case (key, mod) of
                ("plus", [Shift,Control]) -> webViewZoomIn  webView >> return True
                ("minus",[Control])       -> webViewZoomOut webView >> return True
                ("BackSpace", [])         -> webViewGoBack  webView >> return True
                _                         -> return False
        return (Just docs, map ConnectC [cid1, cid2])
#else
        return (Just docs, [])
#endif


getDocumentation :: Maybe PanePath -> IDEM IDEDocumentation
getDocumentation Nothing    = forceGetPane (Right "*Doc")
getDocumentation (Just pp)  = forceGetPane (Left pp)

loadDoc :: Text -> IDEAction
loadDoc uri =
#ifdef WEBKITGTK
     do doc <- getDocumentation Nothing
        let view = webView doc
        liftIO $ webViewLoadUri view uri
#else
        return ()
#endif

reloadDoc :: IDEAction
reloadDoc =
#ifdef WEBKITGTK
     do doc <- getDocumentation Nothing
        let view = webView doc
        liftIO $ webViewReload view
#else
        return ()
#endif