-- 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, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances, GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
module Manatee.Core.Types where

import Control.Concurrent.STM 
import DBus.Client hiding (Signal)
import DBus.Types
import Data.Binary
import Data.Derive.Ord
import Data.Derive.Read
import Data.DeriveTH
import Data.Function
import Data.Map (Map)
import Data.Ord
import Data.Sequence (Seq)
import Data.Set
import Data.Text.Lazy (Text)
import Data.Typeable
import Graphics.UI.Gtk hiding (on, get, Action, Statusbar, statusbarNew, Window, Frame, frameNew, Plug)
import Graphics.UI.Gtk.Gdk.SerializedEvent
import Language.Haskell.TH
import Manatee.Core.TH
import Manatee.Toolkit.Gtk.ScrolledWindow
import Manatee.Toolkit.Gtk.Struct
import Manatee.Toolkit.Widget.Plug
import System.Posix.Types (ProcessID)

-- | Page is widget container for render view.
data Page = Page {pageId        :: PageId
                 ,pageType      :: PageType
                 ,pagePlug      :: Plug
                 ,pageView      :: PageViewWrap
                 }

type PagePlug = Plug

instance Eq Page where
    (==) = (==) `on` (plugId . pagePlug)

instance Ord Page where
    compare = comparing (plugId . pagePlug)

-- | PageList
-- Contain pages (different view for same buffer) in child process.
-- Build index for looking for corresponding page.
type PageList = Set Page

-- | PageType for different type page.
type PageType = String

data PageTypeRule = 
    PageTypeRule (Map PageType String)
    deriving (Show, Read, Eq, Ord, Typeable)

data FileOpenRule =
    FileOpenRule (Map FileMatch [(FileOpenName, PageType, FilePrefix)])
                 deriving (Show, Read, Eq, Ord, Typeable)

type FileOpenName = String
type FilePrefix = String

data PageModeRule =
    PageModeRule (Map PageType (Either 
                                     PageModeName 
                                     (Map String PageModeName)))
                 deriving (Show, Read, Eq, Ord, Typeable)

data PageModeDuplicateList = 
    PageModeDuplicateList [PageModeName]
                 deriving (Show, Read, Eq, Ord, Typeable)

data FileMatch = ContentTypeMatch String
               | RegexpMatch String
                 deriving (Show, Read, Eq, Ord, Typeable)

data ExtensionGloalKeymap = 
    ExtensionGloalKeymap (Map String (String, String, [String]))
                         deriving (Show, Read, Eq, Ord, Typeable)

-- | BufferList
newtype BufferList = 
    BufferList (Map PageModeName (Seq Buffer)) 
               deriving Show

data Buffer =
    Buffer {bufferProcessId     :: ProcessID
           ,bufferPageId        :: PageId
           ,bufferPageType      :: PageType
           ,bufferPath          :: String
           ,bufferName          :: String
           }
    deriving (Show, Read, Eq, Ord)

data BufferInfo = 
    BufferInfo {bufferInfoMode  :: PageModeName
               ,bufferInfoPath  :: PagePath
               ,bufferInfoName  :: String
               ,bufferInfoId    :: PageId} 
    deriving (Show, Read, Eq, Ord, Typeable)

data BufferHistory =
    BufferHistory {bufferHistoryMode    :: PageModeName
                  ,bufferHistoryType    :: PageType
                  ,bufferHistoryPath    :: PagePath}
    deriving (Show, Read, Eq, Ord, Typeable)

data BrowseHistoryList = 
    BrowseHistoryList (Map String String)
    deriving (Show, Read, Eq, Ord, Typeable)

type BufferInfoList = [BufferInfo]
type BufferHistoryList = [BufferHistory]

-- | PageMode
type PageModeName   = String
type PageModeRegexp = String

data PageMode = 
    PageMode {pageModeName      :: PageModeName
             ,pageModeRegexp    :: PageModeRegexp
             ,pageModeKeymap    :: PageViewKeymap
             ,pageModeLoad      :: forall a . PageView a => a -> IO ()}

-- | PageBuffer
class Typeable a => PageBuffer a where
    pageBufferGetName           :: a -> IO String
    pageBufferSetName           :: a -> String -> IO ()
    pageBufferClient            :: a -> Client
    pageBufferCreateView        :: a -> PagePlugId -> IO PageViewWrap
    pageBufferMode              :: a -> PageMode

data PageBufferWrap = forall a . PageBuffer a => PageBufferWrap a

-- | Page buffer new function.
type PageBufferNewFun = FilePath -> [String] -> Client -> PageId -> IO PageBufferWrap

-- | PageView class.
class Typeable a => PageView a where
    pageViewBuffer              :: a -> PageBufferWrap
    pageViewPlugId              :: a -> TVar PagePlugId
    pageViewHandleKeyAction     :: a -> Text -> SerializedEvent -> IO ()
    pageViewFocus               :: a -> IO ()       
    pageViewCopy                :: a -> IO Bool
    pageViewCopy _ = return False
    pageViewCut                 :: a -> IO Bool
    pageViewCut _ = return False
    pageViewPaste               :: a -> IO Bool
    pageViewPaste _ = return False
    pageViewScrolledWindow      :: a -> ScrolledWindow
    pageViewScrollToTop         :: a -> IO ()
    pageViewScrollToTop = 
        scrolledWindowScrollToTop . pageViewScrolledWindow
    pageViewScrollToBottom      :: a -> IO ()
    pageViewScrollToBottom =
        scrolledWindowScrollToBottom . pageViewScrolledWindow
    pageViewScrollVerticalPage  :: Bool -> a -> IO ()
    pageViewScrollVerticalPage isDown a =
        scrolledWindowScrollVerticalPage isDown (pageViewScrolledWindow a)
    pageViewScrollVerticalStep  :: Bool -> a -> IO ()
    pageViewScrollVerticalStep isDown a = 
        scrolledWindowScrollVerticalStep isDown (pageViewScrolledWindow a)
    pageViewScrollToLeft        :: a -> IO ()
    pageViewScrollToLeft = 
        scrolledWindowScrollToLeft . pageViewScrolledWindow
    pageViewScrollToRight       :: a -> IO ()
    pageViewScrollToRight =
        scrolledWindowScrollToRight . pageViewScrolledWindow
    pageViewScrollHorizontalPage:: Bool -> a -> IO ()
    pageViewScrollHorizontalPage isDown a =
        scrolledWindowScrollHorizontalPage isDown (pageViewScrolledWindow a)
    pageViewScrollHorizontalStep:: Bool -> a -> IO ()
    pageViewScrollHorizontalStep isDown a = 
        scrolledWindowScrollHorizontalStep isDown (pageViewScrolledWindow a)

data PageViewWrap = forall a . PageView a => PageViewWrap a

type PageViewKeymap = forall a . PageView a => Map Text (a -> IO ())

data AnythingInteractiveType = GlobalSearch
                             | GlobalInteractive
                             | LocalInteractive
                               deriving (Show, Ord, Eq, Read)
                                        
-- | DBus
type AnythingKeyPressId = Int
type PageId             = Int
type PageSocketId       = GWindowId
type PagePlugId         = GWindowId
type PagePath           = String
type SignalBoxId        = Int
type InteractiveString  = (PagePlugId, String)
type InteractiveResult  = [String]

$(derive makeOrd ''Color)
$(derive makeRead ''Color)

-- | Variant instance for serialize value to DBus system.
deriveVariable (conT ''ProcessID)
deriveVariable (conT ''GWindowId)
deriveVariable (conT ''Color)
deriveVariable (conT ''Maybe `appT` conT ''Color)
deriveVariable (conT ''Int)
deriveVariable (conT ''Maybe `appT` conT ''Char)
deriveVariable (conT ''Maybe `appT` conT ''Int)
deriveVariable (conT ''SerializedEvent)
deriveVariable (conT ''BufferInfoList)
deriveVariable (conT ''BufferHistoryList)
deriveVariable (conT ''Maybe `appT` conT ''Point)
deriveVariable (conT ''InteractiveString)
deriveVariable (conT ''InteractiveResult)
deriveVariable (conT ''AnythingInteractiveType)

data DaemonMember = NewRenderPageConfirm   
                  | NewAnythingProcessConfirm
                  | RenderProcessExit      
                  | RenderProcessException 
                  | NewTab
                  | AnythingViewOutput
                  | LocalInteractivebarExit
                  | LocalOutputbarUpdate
                  | LocalStatusbarUpdate
                  | LocalProgressUpdate
                  | SynchronizationPathName
                  | ChangeTabName
                  | SwitchBuffer
                  | ShowTooltip
                  | LocalInteractiveReturn
                  | GlobalInteractiveReturn
                    deriving (Show, Eq, Ord)

data DaemonSignalArgs = NewRenderPageConfirmArgs PageId PageType SignalBoxId PagePlugId ProcessID PageModeName String Bool 
                      | NewAnythingProcessConfirmArgs PagePlugId ProcessID
                      | RenderProcessExitArgs PageId ProcessID
                      | RenderProcessExceptionArgs PageId
                      | NewTabArgs PageType PagePath [String]
                      | AnythingViewOutputArgs String String (Maybe Int) AnythingKeyPressId
                      | LocalInteractivebarExitArgs
                      | LocalOutputbarUpdateArgs PagePlugId String
                      | LocalStatusbarUpdateArgs PagePlugId String String
                      | LocalProgressUpdateArgs PagePlugId Double
                      | SynchronizationPathNameArgs PageModeName PageId String
                      | ChangeTabNameArgs PageModeName PageId String
                      | SwitchBufferArgs PageModeName PageId
                      | ShowTooltipArgs String (Maybe Point) Int (Maybe Color) (Maybe Color) Bool (Maybe PageId)
                      | LocalInteractiveReturnArgs [String]
                      | GlobalInteractiveReturnArgs [String]
                        deriving (Show, Eq, Ord)

data RenderMember = CloneRenderPage
                  | ReparentRenderPage
                  | FocusRenderPage
                  | PageViewKeyPress
                  | DestroyRenderPage
                  | ExitRenderProcess
                  | AnythingViewKeyPress
                  | AnythingViewChangeCandidate
                  | AnythingViewChangeInteractiveType
                    deriving (Show, Eq, Ord)

data RenderSignalArgs = CloneRenderPageArgs PageId SignalBoxId
                      | ReparentRenderPageArgs PageId PagePlugId SignalBoxId
                      | FocusRenderPageArgs PagePlugId
                      | PageViewKeyPressArgs PagePlugId Text SerializedEvent
                      | DestroyRenderPageArgs PageId PagePlugId
                      | ExitRenderProcessArgs PageId
                      | AnythingViewKeyPressArgs Text String String AnythingKeyPressId Bool
                      | AnythingViewChangeCandidateArgs [String]
                      | AnythingViewChangeInteractiveTypeArgs AnythingInteractiveType
                        deriving (Show, Eq, Ord)

data DaemonBroadcastMember = ExitDaemonProcess
                           deriving (Show, Eq, Ord)

data DaemonBroadcastSignalArgs = ExitDaemonProcessArgs
                                 deriving (Show, Eq, Ord)

data AnythingSearchArgs = GlobalSearchArgs
                        | InteractiveSearchArgs AnythingInteractiveType [String]
                          deriving (Show, Eq, Ord, Read)

data SpawnProcessArgs = SpawnRenderProcessArgs PageId PageType SignalBoxId PagePath [String]
                      | SpawnAnythingProcessArgs AnythingSearchArgs
                        deriving (Show, Eq, Ord, Read)

$(derive makeBinary ''BrowseHistoryList)
$(derive makeBinary ''PageTypeRule)
$(derive makeBinary ''FileMatch)
$(derive makeBinary ''FileOpenRule)
$(derive makeBinary ''PageModeRule)
$(derive makeBinary ''PageModeDuplicateList)
$(derive makeBinary ''ExtensionGloalKeymap)