{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-} module Yi.Snippet.Internal ( Snippet (..) , Var (..) , VarValue (..) , SnippetBody , EditState (..) , EditAction (..) , initialEditState , lit , line , nl , place , refer , finish , mirror , renderSnippet , collectVars , advanceEditState , expandSnippetE , filename ) where import Control.Monad.Free import Control.Monad.State hiding (state) import Control.Monad.Writer import Data.Binary (Binary) import Data.Default import qualified Data.Map.Strict as M import Data.Maybe import Data.Typeable import GHC.Generics import Lens.Micro.Platform ((.~)) import Yi.Buffer import Yi.Editor (withCurrentBuffer) import Yi.Keymap import Yi.Keymap.Keys import qualified Yi.Rope as R import Yi.Types (YiVariable, EditorM) data Snippet = Snippet { Snippet -> YiString snipTrigger :: R.YiString , Snippet -> SnippetBody () snipBody :: SnippetBody () } data Var = FilenameVar | UserVar {Var -> Int fromVar :: Int} deriving (Int -> Var -> ShowS [Var] -> ShowS Var -> String (Int -> Var -> ShowS) -> (Var -> String) -> ([Var] -> ShowS) -> Show Var forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Var] -> ShowS $cshowList :: [Var] -> ShowS show :: Var -> String $cshow :: Var -> String showsPrec :: Int -> Var -> ShowS $cshowsPrec :: Int -> Var -> ShowS Show, Var -> Var -> Bool (Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Var -> Var -> Bool $c/= :: Var -> Var -> Bool == :: Var -> Var -> Bool $c== :: Var -> Var -> Bool Eq, Eq Var Eq Var -> (Var -> Var -> Ordering) -> (Var -> Var -> Bool) -> (Var -> Var -> Bool) -> (Var -> Var -> Bool) -> (Var -> Var -> Bool) -> (Var -> Var -> Var) -> (Var -> Var -> Var) -> Ord Var Var -> Var -> Bool Var -> Var -> Ordering Var -> Var -> Var forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Var -> Var -> Var $cmin :: Var -> Var -> Var max :: Var -> Var -> Var $cmax :: Var -> Var -> Var >= :: Var -> Var -> Bool $c>= :: Var -> Var -> Bool > :: Var -> Var -> Bool $c> :: Var -> Var -> Bool <= :: Var -> Var -> Bool $c<= :: Var -> Var -> Bool < :: Var -> Var -> Bool $c< :: Var -> Var -> Bool compare :: Var -> Var -> Ordering $ccompare :: Var -> Var -> Ordering $cp1Ord :: Eq Var Ord, (forall x. Var -> Rep Var x) -> (forall x. Rep Var x -> Var) -> Generic Var forall x. Rep Var x -> Var forall x. Var -> Rep Var x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Var x -> Var $cfrom :: forall x. Var -> Rep Var x Generic) data VarValue = DefaultValue R.YiString | CustomValue R.YiString deriving (Int -> VarValue -> ShowS [VarValue] -> ShowS VarValue -> String (Int -> VarValue -> ShowS) -> (VarValue -> String) -> ([VarValue] -> ShowS) -> Show VarValue forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [VarValue] -> ShowS $cshowList :: [VarValue] -> ShowS show :: VarValue -> String $cshow :: VarValue -> String showsPrec :: Int -> VarValue -> ShowS $cshowsPrec :: Int -> VarValue -> ShowS Show, VarValue -> VarValue -> Bool (VarValue -> VarValue -> Bool) -> (VarValue -> VarValue -> Bool) -> Eq VarValue forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: VarValue -> VarValue -> Bool $c/= :: VarValue -> VarValue -> Bool == :: VarValue -> VarValue -> Bool $c== :: VarValue -> VarValue -> Bool Eq, (forall x. VarValue -> Rep VarValue x) -> (forall x. Rep VarValue x -> VarValue) -> Generic VarValue forall x. Rep VarValue x -> VarValue forall x. VarValue -> Rep VarValue x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep VarValue x -> VarValue $cfrom :: forall x. VarValue -> Rep VarValue x Generic) instance Binary Var instance Binary VarValue instance Default VarValue where def :: VarValue def = YiString -> VarValue DefaultValue YiString forall a. Monoid a => a mempty type Vars = M.Map Var VarValue data SnippetBodyF a = Lit R.YiString a | Finish a | MakeVar R.YiString (Var -> a) | Mirror Var a | Refer Var (R.YiString -> a) deriving a -> SnippetBodyF b -> SnippetBodyF a (a -> b) -> SnippetBodyF a -> SnippetBodyF b (forall a b. (a -> b) -> SnippetBodyF a -> SnippetBodyF b) -> (forall a b. a -> SnippetBodyF b -> SnippetBodyF a) -> Functor SnippetBodyF forall a b. a -> SnippetBodyF b -> SnippetBodyF a forall a b. (a -> b) -> SnippetBodyF a -> SnippetBodyF b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> SnippetBodyF b -> SnippetBodyF a $c<$ :: forall a b. a -> SnippetBodyF b -> SnippetBodyF a fmap :: (a -> b) -> SnippetBodyF a -> SnippetBodyF b $cfmap :: forall a b. (a -> b) -> SnippetBodyF a -> SnippetBodyF b Functor type SnippetBody = Free SnippetBodyF filename :: Var filename :: Var filename = Var FilenameVar lit :: R.YiString -> SnippetBody () lit :: YiString -> SnippetBody () lit YiString s = SnippetBodyF () -> SnippetBody () forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a liftF (YiString -> () -> SnippetBodyF () forall a. YiString -> a -> SnippetBodyF a Lit YiString s ()) line :: R.YiString -> SnippetBody () line :: YiString -> SnippetBody () line YiString s = YiString -> SnippetBody () lit (YiString s YiString -> YiString -> YiString forall a. Semigroup a => a -> a -> a <> YiString "\n") nl :: SnippetBody () nl :: SnippetBody () nl = SnippetBodyF () -> SnippetBody () forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a liftF (YiString -> () -> SnippetBodyF () forall a. YiString -> a -> SnippetBodyF a Lit YiString "\n" ()) finish :: SnippetBody () finish :: SnippetBody () finish = SnippetBodyF () -> SnippetBody () forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a liftF (() -> SnippetBodyF () forall a. a -> SnippetBodyF a Finish ()) place :: R.YiString -> SnippetBody Var place :: YiString -> SnippetBody Var place YiString s = do Var var <- SnippetBodyF Var -> SnippetBody Var forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a liftF (YiString -> (Var -> Var) -> SnippetBodyF Var forall a. YiString -> (Var -> a) -> SnippetBodyF a MakeVar YiString s Var -> Var forall a. a -> a id) Var -> SnippetBody () mirror Var var Var -> SnippetBody Var forall (m :: * -> *) a. Monad m => a -> m a return Var var refer :: Var -> SnippetBody R.YiString refer :: Var -> SnippetBody YiString refer Var var = SnippetBodyF YiString -> SnippetBody YiString forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a liftF (Var -> (YiString -> YiString) -> SnippetBodyF YiString forall a. Var -> (YiString -> a) -> SnippetBodyF a Refer Var var YiString -> YiString forall a. a -> a id) mirror :: Var -> SnippetBody () mirror :: Var -> SnippetBody () mirror Var var = SnippetBodyF () -> SnippetBody () forall (f :: * -> *) (m :: * -> *) a. (Functor f, MonadFree f m) => f a -> m a liftF (Var -> () -> SnippetBodyF () forall a. Var -> a -> SnippetBodyF a Mirror Var var ()) data EditState = EditState { EditState -> (Maybe Var, Int) sesCursorPosition :: (Maybe Var, Int) , EditState -> Vars sesVars :: Vars } deriving (Int -> EditState -> ShowS [EditState] -> ShowS EditState -> String (Int -> EditState -> ShowS) -> (EditState -> String) -> ([EditState] -> ShowS) -> Show EditState forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [EditState] -> ShowS $cshowList :: [EditState] -> ShowS show :: EditState -> String $cshow :: EditState -> String showsPrec :: Int -> EditState -> ShowS $cshowsPrec :: Int -> EditState -> ShowS Show, EditState -> EditState -> Bool (EditState -> EditState -> Bool) -> (EditState -> EditState -> Bool) -> Eq EditState forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: EditState -> EditState -> Bool $c/= :: EditState -> EditState -> Bool == :: EditState -> EditState -> Bool $c== :: EditState -> EditState -> Bool Eq, (forall x. EditState -> Rep EditState x) -> (forall x. Rep EditState x -> EditState) -> Generic EditState forall x. Rep EditState x -> EditState forall x. EditState -> Rep EditState x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep EditState x -> EditState $cfrom :: forall x. EditState -> Rep EditState x Generic, Typeable) instance Binary EditState instance Default EditState where def :: EditState def = (Maybe Var, Int) -> Vars -> EditState EditState (Maybe Var forall a. Maybe a Nothing, Int 0) Vars forall a. Default a => a def instance YiVariable EditState initialEditState :: Snippet -> EditState initialEditState :: Snippet -> EditState initialEditState (Snippet YiString _ SnippetBody () body) = (Maybe Var, Int) -> Vars -> EditState EditState ([Var] -> Maybe Var forall a. [a] -> Maybe a listToMaybe (Vars -> [Var] forall k a. Map k a -> [k] M.keys Vars vars), Int 0) Vars vars where vars :: Vars vars = SnippetBody () -> Vars forall a. SnippetBody a -> Vars collectVars SnippetBody () body collectVars :: SnippetBody a -> Vars collectVars :: SnippetBody a -> Vars collectVars SnippetBody a body = (a, Vars) -> Vars forall a b. (a, b) -> b snd (State Vars a -> Vars -> (a, Vars) forall s a. State s a -> s -> (a, s) runState ((SnippetBodyF (State Vars a) -> State Vars a) -> SnippetBody a -> State Vars a forall (m :: * -> *) (f :: * -> *) a. (Monad m, Functor f) => (f (m a) -> m a) -> Free f a -> m a iterM SnippetBodyF (State Vars a) -> State Vars a forall a. SnippetBodyF (State Vars a) -> State Vars a run SnippetBody a body) Vars forall a. Monoid a => a mempty) where run :: SnippetBodyF (State Vars a) -> State Vars a run :: SnippetBodyF (State Vars a) -> State Vars a run (Lit YiString _ State Vars a rest) = State Vars a rest run (Finish State Vars a rest) = State Vars a rest run (MakeVar YiString s Var -> State Vars a f) = do Vars vars <- StateT Vars Identity Vars forall s (m :: * -> *). MonadState s m => m s get let newVar :: Var newVar = if Vars -> Bool forall k a. Map k a -> Bool M.null Vars vars then (Int -> Var UserVar Int 0) else Int -> Var UserVar ([Int] -> Int forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ((Var -> Int) -> [Var] -> [Int] forall a b. (a -> b) -> [a] -> [b] map Var -> Int fromVar (Vars -> [Var] forall k a. Map k a -> [k] M.keys Vars vars)) Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) newVars :: Vars newVars = Var -> VarValue -> Vars -> Vars forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert Var newVar (YiString -> VarValue DefaultValue YiString s) Vars vars Vars -> StateT Vars Identity () forall s (m :: * -> *). MonadState s m => s -> m () put Vars newVars Var -> State Vars a f Var newVar run (Mirror Var _ State Vars a rest) = State Vars a rest run (Refer Var var YiString -> State Vars a f) = do Vars vars <- StateT Vars Identity Vars forall s (m :: * -> *). MonadState s m => m s get YiString -> State Vars a f (VarValue -> YiString toYiString (Vars vars Vars -> Var -> VarValue forall k a. Ord k => Map k a -> k -> a M.! Var var)) data EditAction = SENext | SEInsertChar Char | SEBackSpace | SEEscape renderSnippet :: Snippet -> EditState -> (Int, R.YiString) renderSnippet :: Snippet -> EditState -> (Int, YiString) renderSnippet (Snippet YiString _ SnippetBody () body) (EditState (Maybe Var maybeActiveVar, Int offset) Vars vars) = ((Int -> Int) -> (Int -> Int) -> Either Int Int -> Int forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either Int -> Int forall a. a -> a id Int -> Int forall a. a -> a id Either Int Int epos, YiString string) where (((), (Var _var, Either Int Int epos)), YiString string) = Writer YiString ((), (Var, Either Int Int)) -> (((), (Var, Either Int Int)), YiString) forall w a. Writer w a -> (a, w) runWriter (StateT (Var, Either Int Int) (Writer YiString) () -> (Var, Either Int Int) -> Writer YiString ((), (Var, Either Int Int)) forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s) runStateT ((SnippetBodyF (StateT (Var, Either Int Int) (Writer YiString) ()) -> StateT (Var, Either Int Int) (Writer YiString) ()) -> SnippetBody () -> StateT (Var, Either Int Int) (Writer YiString) () forall (m :: * -> *) (f :: * -> *) a. (Monad m, Functor f) => (f (m a) -> m a) -> Free f a -> m a iterM SnippetBodyF (StateT (Var, Either Int Int) (Writer YiString) ()) -> StateT (Var, Either Int Int) (Writer YiString) () forall a. SnippetBodyF (StateT (Var, Either Int Int) (Writer YiString) a) -> StateT (Var, Either Int Int) (Writer YiString) a run SnippetBody () body) (Int -> Var UserVar (-Int 1), Int -> Either Int Int forall a b. b -> Either a b Right Int 0)) advance :: MonadState (Var, Either Int Int) m => Int -> m () advance :: Int -> m () advance Int n = ((Var, Either Int Int) -> (Var, Either Int Int)) -> m () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((Either Int Int -> Either Int Int) -> (Var, Either Int Int) -> (Var, Either Int Int) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((Int -> Int) -> Either Int Int -> Either Int Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int -> Int -> Int forall a. Num a => a -> a -> a + Int n))) run :: SnippetBodyF ((StateT (Var, Either Int Int) (Writer R.YiString)) a) -> StateT (Var, Either Int Int) (Writer R.YiString) a run :: SnippetBodyF (StateT (Var, Either Int Int) (Writer YiString) a) -> StateT (Var, Either Int Int) (Writer YiString) a run (Lit YiString s StateT (Var, Either Int Int) (Writer YiString) a rest) = do YiString -> StateT (Var, Either Int Int) (Writer YiString) () forall w (m :: * -> *). MonadWriter w m => w -> m () tell YiString s Int -> StateT (Var, Either Int Int) (Writer YiString) () forall (m :: * -> *). MonadState (Var, Either Int Int) m => Int -> m () advance (YiString -> Int R.length YiString s) StateT (Var, Either Int Int) (Writer YiString) a rest run (Finish StateT (Var, Either Int Int) (Writer YiString) a rest) = StateT (Var, Either Int Int) (Writer YiString) a rest run (Mirror Var var StateT (Var, Either Int Int) (Writer YiString) a rest) = do let s :: YiString s = VarValue -> YiString toYiString (Vars vars Vars -> Var -> VarValue forall k a. Ord k => Map k a -> k -> a M.! Var var) YiString -> StateT (Var, Either Int Int) (Writer YiString) () forall w (m :: * -> *). MonadWriter w m => w -> m () tell YiString s if Var -> Maybe Var forall a. a -> Maybe a Just Var var Maybe Var -> Maybe Var -> Bool forall a. Eq a => a -> a -> Bool == Maybe Var maybeActiveVar then do (Var v, Either Int Int curPos) <- StateT (Var, Either Int Int) (Writer YiString) (Var, Either Int Int) forall s (m :: * -> *). MonadState s m => m s get case Either Int Int curPos of Right Int pos -> (Var, Either Int Int) -> StateT (Var, Either Int Int) (Writer YiString) () forall s (m :: * -> *). MonadState s m => s -> m () put (Var v, (Int -> Either Int Int forall a b. a -> Either a b Left (Int pos Int -> Int -> Int forall a. Num a => a -> a -> a + Int offset))) Either Int Int _ -> () -> StateT (Var, Either Int Int) (Writer YiString) () forall (m :: * -> *) a. Monad m => a -> m a return () else Int -> StateT (Var, Either Int Int) (Writer YiString) () forall (m :: * -> *). MonadState (Var, Either Int Int) m => Int -> m () advance (YiString -> Int R.length YiString s) StateT (Var, Either Int Int) (Writer YiString) a rest run (MakeVar YiString _ Var -> StateT (Var, Either Int Int) (Writer YiString) a f) = do (Var varName, Either Int Int pos) <- StateT (Var, Either Int Int) (Writer YiString) (Var, Either Int Int) forall s (m :: * -> *). MonadState s m => m s get let newVar :: Var newVar = Int -> Var UserVar (Var -> Int fromVar Var varName Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) (Var, Either Int Int) -> StateT (Var, Either Int Int) (Writer YiString) () forall s (m :: * -> *). MonadState s m => s -> m () put (Var newVar, Either Int Int pos) Var -> StateT (Var, Either Int Int) (Writer YiString) a f (Var newVar) run (Refer Var var YiString -> StateT (Var, Either Int Int) (Writer YiString) a f) = YiString -> StateT (Var, Either Int Int) (Writer YiString) a f (VarValue -> YiString toYiString (Vars vars Vars -> Var -> VarValue forall k a. Ord k => Map k a -> k -> a M.! Var var)) toYiString :: VarValue -> R.YiString toYiString :: VarValue -> YiString toYiString (DefaultValue YiString s) = YiString s toYiString (CustomValue YiString s) = YiString s advanceEditState :: EditState -> EditAction -> EditState advanceEditState :: EditState -> EditAction -> EditState advanceEditState state :: EditState state@(EditState (Maybe Var Nothing, Int _) Vars _) EditAction SENext = EditState state advanceEditState (EditState (Just Var i, Int pos) Vars vars) (SEInsertChar Char c) = let newVars :: Vars newVars = (VarValue -> VarValue) -> Var -> Vars -> Vars forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a M.adjust (Char -> Int -> VarValue -> VarValue insertChar Char c Int pos) Var i Vars vars in (Maybe Var, Int) -> Vars -> EditState EditState (Var -> Maybe Var forall a. a -> Maybe a Just Var i, Int pos Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) Vars newVars advanceEditState (EditState (Just Var i, Int pos) Vars vars) EditAction SEBackSpace = let newVars :: Vars newVars = (VarValue -> VarValue) -> Var -> Vars -> Vars forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a M.adjust (Int -> VarValue -> VarValue backspace Int pos) Var i Vars vars in (Maybe Var, Int) -> Vars -> EditState EditState (Var -> Maybe Var forall a. a -> Maybe a Just Var i, Int pos Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) Vars newVars advanceEditState (EditState (Just Var i, Int _) Vars vars) EditAction SENext = let nextPlace :: Maybe Var nextPlace = [Var] -> Maybe Var forall a. [a] -> Maybe a listToMaybe ((Var -> Bool) -> [Var] -> [Var] forall a. (a -> Bool) -> [a] -> [a] dropWhile (Var -> Var -> Bool forall a. Ord a => a -> a -> Bool <= Var i) (Vars -> [Var] forall k a. Map k a -> [k] M.keys Vars vars)) in (Maybe Var, Int) -> Vars -> EditState EditState (Maybe Var nextPlace, Int 0) Vars vars advanceEditState EditState state EditAction _ = EditState state insertChar :: Char -> Int -> VarValue -> VarValue insertChar :: Char -> Int -> VarValue -> VarValue insertChar Char c Int _ (DefaultValue YiString _) = YiString -> VarValue CustomValue (Char -> YiString R.singleton Char c) insertChar Char c Int pos (CustomValue YiString s) = YiString -> VarValue CustomValue (YiString lhs YiString -> YiString -> YiString forall a. Semigroup a => a -> a -> a <> Char -> YiString R.singleton Char c YiString -> YiString -> YiString forall a. Semigroup a => a -> a -> a <> YiString rhs) where (YiString lhs, YiString rhs) = Int -> YiString -> (YiString, YiString) R.splitAt Int pos YiString s backspace :: Int -> VarValue -> VarValue backspace :: Int -> VarValue -> VarValue backspace Int _ (DefaultValue YiString _) = YiString -> VarValue CustomValue YiString forall a. Monoid a => a mempty backspace Int 0 VarValue v = VarValue v backspace Int pos (CustomValue YiString s) = YiString -> VarValue CustomValue (YiString lhs YiString -> YiString -> YiString forall a. Semigroup a => a -> a -> a <> Int -> YiString -> YiString R.drop Int 1 YiString rhs) where (YiString lhs, YiString rhs) = Int -> YiString -> (YiString, YiString) R.splitAt (Int pos Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) YiString s expandSnippetE :: EditorM () -> [Snippet] -> EditorM Bool expandSnippetE :: EditorM () -> [Snippet] -> EditorM Bool expandSnippetE EditorM () escapeAction [Snippet] snippets = do YiString trigger <- BufferM YiString -> EditorM YiString forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer BufferM YiString readPrevWordB let match :: Maybe Snippet match = [Snippet] -> Maybe Snippet forall a. [a] -> Maybe a listToMaybe ((Snippet -> Bool) -> [Snippet] -> [Snippet] forall a. (a -> Bool) -> [a] -> [a] filter ((YiString -> YiString -> Bool forall a. Eq a => a -> a -> Bool == YiString trigger) (YiString -> Bool) -> (Snippet -> YiString) -> Snippet -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Snippet -> YiString snipTrigger) [Snippet] snippets) case Maybe Snippet match of Just Snippet snip -> do EditorM () -> Snippet -> EditorM () beginEditingSnippetE EditorM () escapeAction Snippet snip Bool -> EditorM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True Maybe Snippet _ -> Bool -> EditorM Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False beginEditingSnippetE :: EditorM () -> Snippet -> EditorM () beginEditingSnippetE :: EditorM () -> Snippet -> EditorM () beginEditingSnippetE EditorM () escapeAction Snippet snip = do BufferM () -> EditorM () forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer (TextUnit -> Direction -> BufferM () deleteB TextUnit unitWord Direction Backward) Point Int origin <- BufferM Point -> EditorM Point forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer BufferM Point pointB Text filenameValue <- BufferM Text -> EditorM Text forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer ((FBuffer -> Text) -> BufferM Text forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets FBuffer -> Text identString) let editState0 :: EditState editState0 = (\(EditState (Maybe Var, Int) x Vars vars) -> (Maybe Var, Int) -> Vars -> EditState EditState (Maybe Var, Int) x (Var -> VarValue -> Vars -> Vars forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert Var filename (YiString -> VarValue DefaultValue (Text -> YiString R.fromText Text filenameValue)) Vars vars)) (Snippet -> EditState initialEditState Snippet snip) BufferM () -> EditorM () forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer (EditState -> BufferM () forall a (m :: * -> *). (YiVariable a, MonadState FBuffer m, Functor m) => a -> m () putBufferDyn EditState editState0) KeymapSet -> KeymapSet oldKeymap <- BufferM (KeymapSet -> KeymapSet) -> EditorM (KeymapSet -> KeymapSet) forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer ((FBuffer -> KeymapSet -> KeymapSet) -> BufferM (KeymapSet -> KeymapSet) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets ((forall syntax. Mode syntax -> KeymapSet -> KeymapSet) -> FBuffer -> KeymapSet -> KeymapSet forall a. (forall syntax. Mode syntax -> a) -> FBuffer -> a withMode0 forall syntax. Mode syntax -> KeymapSet -> KeymapSet modeKeymap)) BufferM () -> EditorM () forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM () forall a b. (a -> b) -> a -> b $ do let (Int offset, YiString s) = Snippet -> EditState -> (Int, YiString) renderSnippet Snippet snip EditState editState0 YiString -> BufferM () insertN YiString s Point -> BufferM () moveTo (Int -> Point Point (Int origin Int -> Int -> Int forall a. Num a => a -> a -> a + Int offset)) let go :: EditAction -> EditorM () go EditAction SEEscape = do BufferM () -> EditorM () forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer ((forall syntax. Mode syntax -> Mode syntax) -> BufferM () modifyMode ((forall syntax. Mode syntax -> Mode syntax) -> BufferM ()) -> (forall syntax. Mode syntax -> Mode syntax) -> BufferM () forall a b. (a -> b) -> a -> b $ ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet)) -> Mode syntax -> Identity (Mode syntax) forall syntax. Lens' (Mode syntax) (KeymapSet -> KeymapSet) modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet)) -> Mode syntax -> Identity (Mode syntax)) -> (KeymapSet -> KeymapSet) -> Mode syntax -> Mode syntax forall s t a b. ASetter s t a b -> b -> s -> t .~ KeymapSet -> KeymapSet oldKeymap) EditorM () escapeAction go EditAction action = BufferM () -> EditorM () forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM () forall a b. (a -> b) -> a -> b $ do EditState editState <- BufferM EditState forall (m :: * -> *) a. (Default a, YiVariable a, MonadState FBuffer m, Functor m) => m a getBufferDyn let nextEditState :: EditState nextEditState = EditState -> EditAction -> EditState advanceEditState EditState editState EditAction action (Int _, YiString prevS) = Snippet -> EditState -> (Int, YiString) renderSnippet Snippet snip EditState editState Point -> BufferM () moveTo (Int -> Point Point Int origin) Int -> BufferM () deleteN (YiString -> Int R.length YiString prevS) let (Int offset, YiString s) = Snippet -> EditState -> (Int, YiString) renderSnippet Snippet snip EditState nextEditState YiString -> BufferM () insertN YiString s Point -> BufferM () moveTo (Int -> Point Point (Int origin Int -> Int -> Int forall a. Num a => a -> a -> a + Int offset)) case EditState nextEditState of EditState (Just Var _, Int _) Vars _ -> EditState -> BufferM () forall a (m :: * -> *). (YiVariable a, MonadState FBuffer m, Functor m) => a -> m () putBufferDyn EditState nextEditState EditState _ -> (forall syntax. Mode syntax -> Mode syntax) -> BufferM () modifyMode ((forall syntax. Mode syntax -> Mode syntax) -> BufferM ()) -> (forall syntax. Mode syntax -> Mode syntax) -> BufferM () forall a b. (a -> b) -> a -> b $ ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet)) -> Mode syntax -> Identity (Mode syntax) forall syntax. Lens' (Mode syntax) (KeymapSet -> KeymapSet) modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet)) -> Mode syntax -> Identity (Mode syntax)) -> (KeymapSet -> KeymapSet) -> Mode syntax -> Mode syntax forall s t a b. ASetter s t a b -> b -> s -> t .~ KeymapSet -> KeymapSet oldKeymap BufferM () -> EditorM () forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM () forall a b. (a -> b) -> a -> b $ (forall syntax. Mode syntax -> Mode syntax) -> BufferM () modifyMode ((forall syntax. Mode syntax -> Mode syntax) -> BufferM ()) -> (forall syntax. Mode syntax -> Mode syntax) -> BufferM () forall a b. (a -> b) -> a -> b $ ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet)) -> Mode syntax -> Identity (Mode syntax) forall syntax. Lens' (Mode syntax) (KeymapSet -> KeymapSet) modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet)) -> Mode syntax -> Identity (Mode syntax)) -> (KeymapSet -> KeymapSet) -> Mode syntax -> Mode syntax forall s t a b. ASetter s t a b -> b -> s -> t .~ (Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet Lens' KeymapSet Keymap topKeymapA ((Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet) -> Keymap -> KeymapSet -> KeymapSet forall s t a b. ASetter s t a b -> b -> s -> t .~ [Keymap] -> Keymap forall (m :: * -> *) w e a. (MonadInteract m w e, MonadFail m) => [m a] -> m a choice [ I Event Action Char forall (m :: * -> *) w. (MonadFail m, MonadInteract m w Event) => m Char printableChar I Event Action Char -> (Char -> EditorM ()) -> Keymap forall (m :: * -> *) a x b. (MonadInteract m Action Event, YiAction a x, Show x) => m b -> (b -> a) -> m () >>=! EditAction -> EditorM () go (EditAction -> EditorM ()) -> (Char -> EditAction) -> Char -> EditorM () forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> EditAction SEInsertChar , Key -> [Modifier] -> Event Event Key KEsc [] Event -> EditorM () -> Keymap forall (m :: * -> *) a x. (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ?>>! EditAction -> EditorM () go EditAction SEEscape , Key -> [Modifier] -> Event Event Key KTab [] Event -> EditorM () -> Keymap forall (m :: * -> *) a x. (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ?>>! EditAction -> EditorM () go EditAction SENext , Key -> [Modifier] -> Event Event Key KBS [] Event -> EditorM () -> Keymap forall (m :: * -> *) a x. (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ?>>! EditAction -> EditorM () go EditAction SEBackSpace , Key -> [Modifier] -> Event Event (Char -> Key KASCII Char 'h') [Modifier MCtrl] Event -> EditorM () -> Keymap forall (m :: * -> *) a x. (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ?>>! EditAction -> EditorM () go EditAction SEBackSpace , Key -> [Modifier] -> Event Event (Char -> Key KASCII Char '[') [Modifier MCtrl] Event -> EditorM () -> Keymap forall (m :: * -> *) a x. (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ?>>! EditAction -> EditorM () go EditAction SEEscape , Key -> [Modifier] -> Event Event (Char -> Key KASCII Char 'i') [Modifier MCtrl] Event -> EditorM () -> Keymap forall (m :: * -> *) a x. (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ?>>! EditAction -> EditorM () go EditAction SENext ]