module Hob.Context.Types (
App,
EventBus(..),
Context(..),
PreviewCommandHandler(..),
CommandHandler(..),
CommandMatcher(..),
Message(..),
KeyboardBinding,
KeyCommandMatcher,
TextCommandMatcher,
Mode(..),
Event(..),
Editor(..),
EditorList(..),
fromContext,
) where
import Control.Monad.Reader
import Data.Maybe (isJust)
import Data.Monoid
import Graphics.UI.Gtk (Modifier)
import GtkExtras.LargeTreeStore as LTS (TreeStore)
import Hob.Context.FileContext
import Hob.Context.StyleContext
import Hob.Context.UiContext
import Hob.DirectoryTree
type App = ReaderT Context IO
newtype Event = Event String deriving (Eq, Show)
data Editor = Editor {
editorId :: Editor -> App Int,
enterEditorMode :: Editor -> Mode -> App Editor,
exitLastEditorMode :: Editor -> App Editor,
modeStack :: Editor -> App [Mode],
isCurrentlyActive :: Editor -> App Bool
}
data EventBus = EventBus {
addListener :: Event -> App() -> IO(),
listenersForEvent :: Event -> IO [App()]
}
data EditorList = EditorList {
updateEditors :: ([Editor] -> IO [Editor]) -> IO(),
getEditors :: IO [Editor]
}
data Context = Context {
styleContext :: StyleContext,
fileContext :: FileContext,
uiContext :: UiContext,
fileTreeStore :: LTS.TreeStore DirectoryTreeElement,
baseCommands :: CommandMatcher,
editors :: EditorList,
messageLoop :: Context -> Message -> IO(),
eventBus :: EventBus,
idGenerator :: IO Int
}
data Mode = Mode {
modeName :: String,
commandMatcher :: CommandMatcher,
cleanup :: App()
}
data Message = AppAction (App())
data PreviewCommandHandler = PreviewCommandHandler {
previewExecute :: App(),
previewReset :: App()
}
data CommandHandler = CommandHandler {
commandPreview :: Maybe PreviewCommandHandler,
commandExecute :: App()
}
type KeyboardBinding = ([Modifier], String)
type SingleCommandMatcher a = a -> Maybe CommandHandler
type KeyCommandMatcher = SingleCommandMatcher KeyboardBinding
type TextCommandMatcher = SingleCommandMatcher String
data CommandMatcher = CommandMatcher {
matchKeyBinding :: KeyCommandMatcher,
matchCommand :: TextCommandMatcher
}
instance Monoid CommandMatcher where
mempty = CommandMatcher (const Nothing) (const Nothing)
mappend l r = CommandMatcher (combineMatchKeyBinding l r) (combineMatchCommand l r)
where combineMatchKeyBinding = combineMatcher matchKeyBinding
combineMatchCommand = combineMatcher matchCommand
fromContext :: MonadReader r m => (r -> a) -> m a
fromContext = asks
combineMatcher :: (CommandMatcher -> SingleCommandMatcher a) -> CommandMatcher -> CommandMatcher -> SingleCommandMatcher a
combineMatcher combiner l r cmd = if isJust rightResult then rightResult else leftResult
where leftResult = combiner l cmd
rightResult = combiner r cmd