{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- 'Keymap', 'YiM' and 'Action's.


module Yi.Keymap
    ( Action(..)
    , emptyAction
    , Interact
    , KeymapM
    , Keymap
    , KeymapEndo
    , KeymapProcess
    , KeymapSet(..)
    , topKeymapA
    , insertKeymapA
    , extractTopKeymap
    , modelessKeymapSet
    , YiM(..)
    , withUI
    , unsafeWithEditor
    , readEditor
    , catchDynE
    , catchJustE
    , handleJustE
    , YiAction (..)
    , Yi(..)
    , IsRefreshNeeded(..)
    , YiVar(..)
    , write
    , withModeY

    -- * Lenses
    , yiSubprocessesA
    , yiEditorA
    , yiSubprocessIdSupplyA
    , yiConfigA
    , yiInputA
    , yiOutputA
    , yiUiA
    , yiVarA
    ) where

import           Control.Exception    (Exception, catch, catchJust)
import           Control.Monad.Reader (ReaderT (ReaderT, runReaderT))
import           Control.Monad.State  (gets)
import           Yi.Buffer            ()
import qualified Yi.Editor            as Editor (currentBuffer, findBuffer)
import qualified Yi.Interact          as I (MonadInteract, write)
import           Yi.Monad             (with)
import           Yi.Types
import           Yi.UI.Common         (UI)
import           Yi.Utils             (io, makeLensesWithSuffix)


-----------------------
-- Keymap basics

-- | @write a@ returns a keymap that just outputs the action @a@.
write :: (I.MonadInteract m Action ev, YiAction a x, Show x) => a -> m ()
write :: a -> m ()
write a
x = Action -> m ()
forall (m :: * -> *) w e. MonadInteract m w e => w -> m ()
I.write (a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction a
x)

--------------------------------
-- Uninteresting glue code

withUI :: (UI Editor -> IO a) -> YiM a
withUI :: (UI Editor -> IO a) -> YiM a
withUI = (Yi -> UI Editor) -> (UI Editor -> IO a) -> YiM a
forall r (m :: * -> *) (b :: * -> *) a c.
(MonadReader r m, MonadBase b m) =>
(r -> a) -> (a -> b c) -> m c
with Yi -> UI Editor
yiUi

readEditor :: MonadEditor m => (Editor -> a) -> m a
readEditor :: (Editor -> a) -> m a
readEditor Editor -> a
f = EditorM a -> m a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor ((Editor -> a) -> EditorM a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> a
f)

catchDynE :: Exception exception => YiM a -> (exception -> YiM a) -> YiM a
catchDynE :: YiM a -> (exception -> YiM a) -> YiM a
catchDynE (YiM ReaderT Yi IO a
inner) exception -> YiM a
handler
    = ReaderT Yi IO a -> YiM a
forall a. ReaderT Yi IO a -> YiM a
YiM (ReaderT Yi IO a -> YiM a) -> ReaderT Yi IO a -> YiM a
forall a b. (a -> b) -> a -> b
$ (Yi -> IO a) -> ReaderT Yi IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\Yi
r -> IO a -> (exception -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (ReaderT Yi IO a -> Yi -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Yi IO a
inner Yi
r) (\exception
e -> ReaderT Yi IO a -> Yi -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (YiM a -> ReaderT Yi IO a
forall a. YiM a -> ReaderT Yi IO a
runYiM (YiM a -> ReaderT Yi IO a) -> YiM a -> ReaderT Yi IO a
forall a b. (a -> b) -> a -> b
$ exception -> YiM a
handler exception
e) Yi
r))

catchJustE :: (Exception e) => (e -> Maybe b) -- ^ Predicate to select exceptions
           -> YiM a      -- ^ Computation to run
           -> (b -> YiM a) -- ^   Handler
           -> YiM a
catchJustE :: (e -> Maybe b) -> YiM a -> (b -> YiM a) -> YiM a
catchJustE e -> Maybe b
p (YiM ReaderT Yi IO a
c) b -> YiM a
h = ReaderT Yi IO a -> YiM a
forall a. ReaderT Yi IO a -> YiM a
YiM (ReaderT Yi IO a -> YiM a) -> ReaderT Yi IO a -> YiM a
forall a b. (a -> b) -> a -> b
$ (Yi -> IO a) -> ReaderT Yi IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\Yi
r -> (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust e -> Maybe b
p (ReaderT Yi IO a -> Yi -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Yi IO a
c Yi
r) (\b
b -> ReaderT Yi IO a -> Yi -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (YiM a -> ReaderT Yi IO a
forall a. YiM a -> ReaderT Yi IO a
runYiM (YiM a -> ReaderT Yi IO a) -> YiM a -> ReaderT Yi IO a
forall a b. (a -> b) -> a -> b
$ b -> YiM a
h b
b) Yi
r))

handleJustE :: (Exception e) => (e -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a
handleJustE :: (e -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a
handleJustE e -> Maybe b
p b -> YiM a
h YiM a
c = (e -> Maybe b) -> YiM a -> (b -> YiM a) -> YiM a
forall e b a.
Exception e =>
(e -> Maybe b) -> YiM a -> (b -> YiM a) -> YiM a
catchJustE e -> Maybe b
p YiM a
c b -> YiM a
h

-- -------------------------------------------

class YiAction a x | a -> x where
    makeAction :: Show x => a -> Action

instance YiAction (IO x) x where
    makeAction :: IO x -> Action
makeAction = YiM x -> Action
forall a. Show a => YiM a -> Action
YiA (YiM x -> Action) -> (IO x -> YiM x) -> IO x -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO x -> YiM x
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io

instance YiAction (YiM x) x where
    makeAction :: YiM x -> Action
makeAction = YiM x -> Action
forall a. Show a => YiM a -> Action
YiA

instance YiAction (EditorM x) x where
    makeAction :: EditorM x -> Action
makeAction = EditorM x -> Action
forall x. Show x => EditorM x -> Action
EditorA

instance YiAction (BufferM x) x where
    makeAction :: BufferM x -> Action
makeAction = BufferM x -> Action
forall x. Show x => BufferM x -> Action
BufferA

instance YiAction Action () where
    makeAction :: Action -> Action
makeAction = Action -> Action
forall a. a -> a
id

makeLensesWithSuffix "A" ''KeymapSet

modelessKeymapSet :: Keymap -> KeymapSet
modelessKeymapSet :: Keymap -> KeymapSet
modelessKeymapSet Keymap
k = KeymapSet :: Keymap -> Keymap -> KeymapSet
KeymapSet
 { insertKeymap :: Keymap
insertKeymap = Keymap
k
 , topKeymap :: Keymap
topKeymap = Keymap
k
 }

-- | @withModeY f@ runs @f@ on the current buffer's mode. As this runs in
-- the YiM monad, we're able to do more than with just 'withModeB' such as
-- prompt the user for something before running the action.
withModeY :: (forall syntax. Mode syntax -> YiM ()) -> YiM ()
withModeY :: (forall syntax. Mode syntax -> YiM ()) -> YiM ()
withModeY forall syntax. Mode syntax -> YiM ()
f = do
   BufferRef
bufref <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
Editor.currentBuffer
   Maybe FBuffer
mfbuf <- BufferRef -> YiM (Maybe FBuffer)
forall (m :: * -> *).
MonadEditor m =>
BufferRef -> m (Maybe FBuffer)
Editor.findBuffer BufferRef
bufref
   case Maybe FBuffer
mfbuf of
     Maybe FBuffer
Nothing -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just (FBuffer {bmode :: ()
bmode = Mode syntax
m}) -> Mode syntax -> YiM ()
forall syntax. Mode syntax -> YiM ()
f Mode syntax
m

makeLensesWithSuffix "A" ''YiVar
makeLensesWithSuffix "A" ''Yi