module Yi.Keymap
( Action(..)
, emptyAction
, Interact
, KeymapM
, Keymap
, KeymapEndo
, KeymapProcess
, KeymapSet(..)
, topKeymapA
, startInsertKeymapA
, insertKeymapA
, startTopKeymapA
, extractTopKeymap
, modelessKeymapSet
, YiM(..)
, withUI
, unsafeWithEditor
, withGivenBuffer
, withBuffer
, readEditor
, catchDynE
, catchJustE
, handleJustE
, shutdown
, YiAction (..)
, Yi(..)
, YiVar(..)
, write
, withModeY
) where
import Control.Concurrent
import Control.Applicative
import Control.Monad.Reader hiding (mapM_)
import Control.Monad.State hiding (mapM_)
import Control.Monad.Base
import Control.Exception
import Data.Typeable
import Yi.Buffer
import Yi.Config
import Yi.Editor (EditorM, Editor, runEditor, MonadEditor(..))
import Yi.Event
import Yi.Monad
import Yi.Process (SubprocessInfo, SubprocessId)
import Yi.UI.Common
import Yi.Utils
import qualified Data.Map as M
import qualified Yi.Editor as Editor
import qualified Yi.Interact as I
data Action = forall a. Show a => YiA (YiM a)
| forall a. Show a => EditorA (EditorM a)
| forall a. Show a => BufferA (BufferM a)
deriving Typeable
emptyAction :: Action
emptyAction = BufferA (return ())
instance I.PEq Action where
equiv _ _ = False
instance Show Action where
show (YiA _) = "@Y"
show (EditorA _) = "@E"
show (BufferA _) = "@B"
type Interact ev a = I.I ev Action a
type KeymapM a = Interact Event a
type Keymap = KeymapM ()
type KeymapEndo = Keymap -> Keymap
type KeymapProcess = I.P Event Action
data Yi = Yi {yiUi :: UI,
input :: Event -> IO (),
output :: [Action] -> IO (),
yiConfig :: Config,
yiVar :: MVar YiVar
}
deriving Typeable
data YiVar = YiVar {yiEditor :: !Editor,
threads :: ![ThreadId],
yiSubprocessIdSupply :: !SubprocessId,
yiSubprocesses :: !(M.Map SubprocessId SubprocessInfo)
}
newtype YiM a = YiM {runYiM :: ReaderT Yi IO a}
deriving (Monad, Applicative, MonadReader Yi, MonadBase IO, Typeable, Functor)
instance MonadState Editor YiM where
get = yiEditor <$> (readRef =<< yiVar <$> ask)
put v = flip modifyRef (\x -> x {yiEditor = v}) =<< yiVar <$> ask
instance MonadEditor YiM where
askCfg = yiConfig <$> ask
withEditor f = do
r <- asks yiVar
cfg <- asks yiConfig
liftBase $ unsafeWithEditor cfg r f
write :: (I.MonadInteract m Action ev, YiAction a x, Show x) => a -> m ()
write x = I.write (makeAction x)
withUI :: (UI -> IO a) -> YiM a
withUI = with yiUi
unsafeWithEditor :: Config -> MVar YiVar -> EditorM a -> IO a
unsafeWithEditor cfg r f = modifyMVar r $ \var -> do
let e = yiEditor var
let (e',a) = runEditor cfg f e
e' `seq` a `seq` return (var {yiEditor = e'}, a)
withGivenBuffer :: MonadEditor m => BufferRef -> BufferM a -> m a
withGivenBuffer b f = withEditor (Editor.withGivenBuffer0 b f)
withBuffer :: MonadEditor m => BufferM a -> m a
withBuffer f = withEditor (Editor.withBuffer0 f)
readEditor :: MonadEditor m => (Editor -> a) -> m a
readEditor f = withEditor (gets f)
catchDynE :: Exception exception => YiM a -> (exception -> YiM a) -> YiM a
catchDynE (YiM inner) handler
= YiM $ ReaderT (\r -> catch (runReaderT inner r) (\e -> runReaderT (runYiM $ handler e) r))
catchJustE :: (Exception e) => (e -> Maybe b)
-> YiM a
-> (b -> YiM a)
-> YiM a
catchJustE p (YiM c) h = YiM $ ReaderT (\r -> catchJust p (runReaderT c r) (\b -> runReaderT (runYiM $ h b) r))
handleJustE :: (Exception e) => (e -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a
handleJustE p h c = catchJustE p c h
shutdown :: YiM ()
shutdown = do ts <- threads <$> readsRef yiVar
liftBase $ mapM_ killThread ts
class YiAction a x | a -> x where
makeAction :: Show x => a -> Action
instance YiAction (IO x) x where
makeAction = YiA . io
instance YiAction (YiM x) x where
makeAction = YiA
instance YiAction (EditorM x) x where
makeAction = EditorA
instance YiAction (BufferM x) x where
makeAction = BufferA
instance YiAction Action () where
makeAction = id
instance I.PEq Event where
equiv = (==)
data KeymapSet = KeymapSet
{ topKeymap :: Keymap
, startInsertKeymap :: Keymap
, insertKeymap :: Keymap
, startTopKeymap :: Keymap
}
makeLensesWithSuffix "A" ''KeymapSet
extractTopKeymap :: KeymapSet -> Keymap
extractTopKeymap kms = startTopKeymap kms >> forever (topKeymap kms)
modelessKeymapSet :: Keymap -> KeymapSet
modelessKeymapSet k = KeymapSet
{ insertKeymap = k
, startInsertKeymap = return ()
, topKeymap = k
, startTopKeymap = return ()
}
withModeY :: (forall syntax. Mode syntax -> YiM ()) -> YiM ()
withModeY f = do
bufref <- gets Editor.currentBuffer
mfbuf <- withEditor $ Editor.findBuffer bufref
case mfbuf of
Nothing -> return ()
Just (FBuffer {bmode = m}) -> f m