manatee-0.1.8: Manatee/Types.hs
-- 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.Types where
import Control.Applicative hiding (empty)
import Control.Concurrent.MVar
import Control.Concurrent.STM
import DBus.Client hiding (Signal)
import Data.Function
import Data.Map (Map)
import Data.Ord
import Data.Sequence (Seq)
import Data.Set
import Data.Text.Lazy (Text)
import Graphics.UI.Gtk hiding (on, get, Action, Statusbar, statusbarNew, Window, Frame, frameNew, Plug, Tooltip)
import Manatee.Core.Types
import Manatee.Toolkit.Data.ListZipper
import Manatee.Toolkit.Data.SetList
import Manatee.Toolkit.Widget.Interactivebar
import Manatee.Toolkit.Widget.NotebookTab
import Manatee.Toolkit.Widget.PopupWindow
import Manatee.Toolkit.Widget.Tooltip
import Manatee.UI.FocusNotifier
import Manatee.UI.Frame
import System.Posix.Types (ProcessID)
import Text.Printf
-- | Environment.
data Environment =
Environment {envFrame :: Frame
,envDaemonClient :: Client
,envWindowList :: TVar WindowList
,envWindowNodeList :: TVar WindowNodeList
,envTabbar :: TVar Tabbar
,envBufferList :: TVar BufferList
,envSignalBoxList :: TVar SignalBoxList
,envPageIdCounter :: TVar PageId
,envSignalBoxIdCounter :: TVar SignalBoxId
,envFocusNotifierList :: TVar FocusNotifierList
,envInitBox :: VBox
,envInitInteractivebar :: Interactivebar
,envAnythingPopupWindow :: PopupWindow
,envAnythingProcessId :: TVar ProcessID
,envAnythingKeyPressId :: TVar AnythingKeyPressId
,envTooltipCounter :: TVar Int
,envTooltipSet :: TVar (Set Tooltip)
,envLocalInteractiveLock :: MVar (Either Text [String])
,envLocalInteractiveTrack :: TVar [(String, String)]
,envLocalInteractiveReturn :: TVar [String]
,envGlobalInteractiveLock :: MVar (Either Text [String])
,envGlobalInteractiveTrack :: TVar [(String, String)]
,envGlobalInteractiveReturn:: TVar [String]
,envTabCloseHistory :: TVar TabCloseHistory
,envBufferHistory :: TVar [BufferHistory]
}
-- | Tab close history for undo close action.
data TabCloseHistory =
TabCloseHistory [(PageModeName, PageType, PagePath)]
deriving Show
-- | Keymap
-- | The design of `Keymap` is do a friendly, easy keymap interface.
type Keymap = Map Text Action
-- | Action just wrap to taken polymorphism function.
-- It won't store polymorphism function.
-- You can use 'Action' wrap any polymorphism functions that
-- input argument is instance of ActionInputArgs and
-- output argument is instance of ActionOutputArgs.
data Action = forall a b . (ActionInputArgs a, ActionOutputArgs b) =>
Action {actionFun :: a -> IO b}
-- | ActionInputArgs is class to implement polymorphism keymap function.
--
-- Example, you have functions:
--
-- foo :: (Arg1, (Arg2, Arg3)) -> IO ()
-- bar :: (Arg1, (Arg2, (Arg3, Arg4))) -> IO ()
--
-- you can write your keymap with below:
--
-- keymap :: Keymap
-- keymap = M.fromList
-- ["M-1" ==> foo
-- ,"M-2" ==> bar]
--
-- See? It's so flexible.
class ActionInputArgs a where
envGet :: Environment -> IO a
-- | ActionOutputArgs is class to implement polymorphism result.
-- This class is very useful when you want transform pure function to `Keymap`.
-- You can return any result that instance of `ActionOutputArgs`,
-- then system will write those value back to `Environment`.
-- If you want update those value (such as TVar) yourself, just return `()`.
class ActionOutputArgs b where
envPut :: Environment -> b -> IO ()
instance ActionInputArgs () where
envGet _ = return ()
instance (ActionInputArgs a, ActionInputArgs b) => ActionInputArgs (a, b) where
envGet env = liftA2 (,) (envGet env) (envGet env)
instance ActionOutputArgs () where
envPut _ _ = return ()
instance (ActionOutputArgs a, ActionOutputArgs b) => ActionOutputArgs (a, b) where
envPut env (a,b) = envPut env a >> envPut env b
-- | 'SignalBox' build when create socket.
-- Pick info when receive dbus signal.
-- Delete after create new page.
data SignalBox =
SignalBox {signalBoxId :: SignalBoxId
,signalBoxUIFrame :: UIFrame
,signalBoxWindowId :: WindowId
}
instance Eq SignalBox where
(==) = (==) `on` signalBoxId
instance Ord SignalBox where
compare = comparing signalBoxId
type SignalBoxList = Set SignalBox
-- | WindowNode containe window node.
data WindowNode =
WindowNode {windowNodeId :: WindowNodeId
,windowNodePaned :: Paned
,windowNodeParentId :: TVar (Maybe WindowNodeId)
,windowNodeChildLeftId :: TVar (Maybe WindowNodeId)
,windowNodeChildRightId :: TVar (Maybe WindowNodeId)
,windowNodeType :: TVar WindowNodeType
,windowNodeDirection :: WindowNodeDirection}
type WindowNodeId = Int
data WindowNodeType = TNodeLeft
| TNodeRight
| TNodeRoot
deriving (Eq, Show, Read)
data WindowNodeDirection = DVertical
| DHortizontal
deriving (Eq, Show, Read)
data ZoomDirection = ZUp
| ZDown
| ZLeft
| ZRight
deriving (Eq, Show, Read)
instance Eq WindowNode where
(==) = (==) `on` windowNodeId
instance Ord WindowNode where
compare = comparing windowNodeId
type WindowNodeList = SetList WindowNode
-- | Window contain GtkNotebook for contain tabs.
data Window =
Window {windowNode :: WindowNode
,windowNotebook :: Notebook}
instance Eq Window where
(==) = (==) `on` windowNode
instance Ord Window where
compare = comparing windowNode
instance Show Window where
show = printf "<#Window %s>" . show . windowNodeId . windowNode
type WindowList = ListZipper Window
data WindowListSelectDirection = VLeft
| VRight
deriving (Eq, Show, Read)
type WindowId = WindowNodeId
type WindowListTuple = (WindowList, WindowNodeList)
type WindowNodeArgs = (WindowNodeList, Container)
type WindowArgs = (WindowList, WindowNodeList, Container)
type WindowNodeAttr = (Maybe WindowNodeId
,Maybe WindowNodeId
,Maybe WindowNodeId
,Maybe WindowNodeId
,WindowNodeType
,WindowNodeDirection)
-- | Tabbar
-- Contain all tab in windows.
-- For update tab information in windows.
-- PageId for synchronization with different window.
-- Tabbar corresponding Notebook status.
newtype Tabbar =
Tabbar (Map (WindowId, PageModeName) (Seq Tab))
deriving Show
data Tab =
Tab {tabProcessId :: ProcessID
,tabPageId :: PageId
,tabSocketId :: PageSocketId
,tabPlugId :: PagePlugId
,tabUIFrame :: UIFrame}
deriving Show
-- | UIFrame.
data UIFrame =
UIFrame {uiFrameBox :: VBox -- box for contain `PageView'
,uiFrameInteractivebar :: Interactivebar -- interactivebar for interactive input
,uiFrameNotebookTab :: NotebookTab -- notebook tab
}
instance Show UIFrame where
show _ = "UIFrame"
-- | Focus status.
data FocusStatus = FocusInitInteractivebar
| FocusLocalInteractivebar
| FocusWindow
deriving (Eq, Show, Read, Ord)
-- | Anything startup function.
data AnythingStartupFun = AnythingStartupFun (IO ())