{-# 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
        ]