Editor.hs

module Hob.Context.Editor (
    initEditors,
    runOnEditor,
    enterMode,
    exitLastMode,
    activeModes,
    getActiveCommands,
    ) where

import Control.Concurrent.MVar
import Control.Monad.Reader
import Data.Monoid

import Hob.Context.Events
import Hob.Context.Types


runOnEditor :: (Editor -> Editor -> a) -> Editor -> a
runOnEditor f editor = f editor editor

initEditors :: IO EditorList
initEditors = do
    editorList <- newMVar []
    return $ EditorList (updateEditorsHandler editorList) (getEditorsHandler editorList)
    where
        updateEditorsHandler editorList updater = do
            oldEditors <- takeMVar editorList
            newEditors <- updater oldEditors
            putMVar editorList newEditors
        getEditorsHandler = readMVar

currentEditor :: App (Maybe Editor)
currentEditor = do
    editorList <- fromContext editors
    active <- filterM (\e -> isCurrentlyActive e e) =<< liftIO (getEditors editorList)
    return $
        if null active then Nothing
        else Just $ head active

enterMode :: Mode -> App()
enterMode mode = do
    updateActiveEditor $ \editor -> do
        editor' <- clearEditorModes editor
        runOnEditor enterEditorMode editor' mode
    emitEvent $ Event "core.mode.change"
    where clearEditorModes editor = do
              modes <- runOnEditor modeStack editor
              if not . null $ modes then do
                  editor' <- runOnEditor exitLastEditorMode editor
                  clearEditorModes editor'
              else return editor

activeModes :: App (Maybe [Mode])
activeModes = do
    active <- currentEditor
    maybe (return Nothing) (runOnEditor modeStack >=> return . Just) active

exitLastMode :: App()
exitLastMode = do
    updateActiveEditor $ \editor -> runOnEditor exitLastEditorMode editor
    emitEvent $ Event "core.mode.change"

updateActiveEditor :: (Editor -> App Editor) -> App()
updateActiveEditor actions = do
    ctx <- ask
    editorList <- fromContext editors
    liftIO $ updateEditors editorList $ \oldEditors -> runReaderT (updateActiveEditorHandler oldEditors) ctx
    where
        updateActiveEditorHandler oldEditors = do
            (e1, e2) <- splitBeforeFirstActive oldEditors
            if null e2 then return oldEditors
            else do
                let active = head e2
                active' <- actions active
                return $ e1 ++ [active'] ++ tail e2
        splitBeforeFirstActive [] = return ([], [])
        splitBeforeFirstActive (x:xs) = do
            active <- runOnEditor isCurrentlyActive x
            if active then return ([], x:xs)
            else do
                (n, ns) <- splitBeforeFirstActive xs
                return (x:n, ns)

getActiveCommands :: App CommandMatcher
getActiveCommands = do
    base <- asks baseCommands
    maybeModes <- activeModes
    maybe (return base)
          (\modes -> return $ base `mappend` mconcat (fmap commandMatcher modes))
          maybeModes