{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim.Ex.Commands.Common
( parse
, parseWithBang
, parseWithBangAndCount
, parseRange
, BoolOptionAction(..)
, TextOptionAction(..)
, parseBoolOption
, parseTextOption
, filenameComplete
, forAllBuffers
, pureExCommand
, impureExCommand
, errorNoWrite
, commandArgs
, needsSaving
) where
import Control.Applicative (Alternative ((<|>)))
import Lens.Micro.Platform (use)
import Control.Monad (void, (>=>))
import qualified Data.Attoparsec.Text as P (Parser, anyChar, char,
digit, inClass, many',
many1, notInClass, parseOnly,
option, satisfy, space, string)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Monoid ((<>))
import qualified Data.Text as T (Text, concat, cons, drop,
isPrefixOf, length, pack,
singleton, snoc)
import System.Directory (getCurrentDirectory)
import Text.Read (readMaybe)
import Yi.Buffer
import Yi.Editor
import Yi.File (deservesSave)
import Yi.Keymap (Action, YiM, readEditor)
import Yi.Keymap.Vim.Common (EventString (Ev))
import Yi.Keymap.Vim.Ex.Types (ExCommand (..))
import Yi.Misc (matchingFileNames)
import Yi.Monad (gets)
import Yi.Style (errorStyle)
import Yi.Utils (io)
parse :: P.Parser ExCommand -> EventString -> Maybe ExCommand
parse :: Parser ExCommand -> EventString -> Maybe ExCommand
parse Parser ExCommand
parser (Ev Text
s) =
(String -> Maybe ExCommand)
-> (ExCommand -> Maybe ExCommand)
-> Either String ExCommand
-> Maybe ExCommand
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ExCommand -> String -> Maybe ExCommand
forall a b. a -> b -> a
const Maybe ExCommand
forall a. Maybe a
Nothing) ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just (Either String ExCommand -> Maybe ExCommand)
-> Either String ExCommand -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ Parser ExCommand -> Text -> Either String ExCommand
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser ExCommand
parser Text
s
parseWithBangAndCount :: P.Parser a
-> (a -> Bool
-> Maybe Int
-> P.Parser ExCommand)
-> EventString
-> Maybe ExCommand
parseWithBangAndCount :: Parser a
-> (a -> Bool -> Maybe Int -> Parser ExCommand)
-> EventString
-> Maybe ExCommand
parseWithBangAndCount Parser a
nameParser a -> Bool -> Maybe Int -> Parser ExCommand
argumentParser (Ev Text
s) =
(String -> Maybe ExCommand)
-> (ExCommand -> Maybe ExCommand)
-> Either String ExCommand
-> Maybe ExCommand
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ExCommand -> String -> Maybe ExCommand
forall a b. a -> b -> a
const Maybe ExCommand
forall a. Maybe a
Nothing) ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just (Parser ExCommand -> Text -> Either String ExCommand
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser ExCommand
parser Text
s)
where
parser :: Parser ExCommand
parser = do
Maybe Int
mcount <- Parser (Maybe Int)
parseCount
a
a <- Parser a
nameParser
Bool
bang <- Parser Bool
parseBang
a -> Bool -> Maybe Int -> Parser ExCommand
argumentParser a
a Bool
bang Maybe Int
mcount
parseWithBang :: P.Parser a
-> (a -> Bool -> P.Parser ExCommand)
-> EventString
-> Maybe ExCommand
parseWithBang :: Parser a
-> (a -> Bool -> Parser ExCommand)
-> EventString
-> Maybe ExCommand
parseWithBang Parser a
nameParser a -> Bool -> Parser ExCommand
argumentParser (Ev Text
s) =
(String -> Maybe ExCommand)
-> (ExCommand -> Maybe ExCommand)
-> Either String ExCommand
-> Maybe ExCommand
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ExCommand -> String -> Maybe ExCommand
forall a b. a -> b -> a
const Maybe ExCommand
forall a. Maybe a
Nothing) ExCommand -> Maybe ExCommand
forall a. a -> Maybe a
Just (Parser ExCommand -> Text -> Either String ExCommand
forall a. Parser a -> Text -> Either String a
P.parseOnly Parser ExCommand
parser Text
s)
where
parser :: Parser ExCommand
parser = do
a
a <- Parser a
nameParser
Bool
bang <- Parser Bool
parseBang
a -> Bool -> Parser ExCommand
argumentParser a
a Bool
bang
parseBang :: P.Parser Bool
parseBang :: Parser Bool
parseBang = Text -> Parser Text
P.string Text
"!" Parser Text -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
parseCount :: P.Parser (Maybe Int)
parseCount :: Parser (Maybe Int)
parseCount = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> Parser Text String -> Parser (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text Char
P.digit
parseRange :: P.Parser (Maybe (BufferM Region))
parseRange :: Parser (Maybe (BufferM Region))
parseRange = (BufferM Region -> Maybe (BufferM Region))
-> Parser Text (BufferM Region) -> Parser (Maybe (BufferM Region))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BufferM Region -> Maybe (BufferM Region)
forall a. a -> Maybe a
Just Parser Text (BufferM Region)
parseFullRange
Parser (Maybe (BufferM Region))
-> Parser (Maybe (BufferM Region))
-> Parser (Maybe (BufferM Region))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BufferM Region -> Maybe (BufferM Region))
-> Parser Text (BufferM Region) -> Parser (Maybe (BufferM Region))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BufferM Region -> Maybe (BufferM Region)
forall a. a -> Maybe a
Just (Parser Text (BufferM Region) -> Parser Text (BufferM Region)
styleRange Parser Text (BufferM Region)
parsePointRange)
Parser (Maybe (BufferM Region))
-> Parser (Maybe (BufferM Region))
-> Parser (Maybe (BufferM Region))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (BufferM Region) -> Parser (Maybe (BufferM Region))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BufferM Region)
forall a. Maybe a
Nothing
styleRange :: P.Parser (BufferM Region) -> P.Parser (BufferM Region)
styleRange :: Parser Text (BufferM Region) -> Parser Text (BufferM Region)
styleRange = (BufferM Region -> BufferM Region)
-> Parser Text (BufferM Region) -> Parser Text (BufferM Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BufferM Region -> BufferM Region)
-> Parser Text (BufferM Region) -> Parser Text (BufferM Region))
-> (BufferM Region -> BufferM Region)
-> Parser Text (BufferM Region)
-> Parser Text (BufferM Region)
forall a b. (a -> b) -> a -> b
$ \BufferM Region
regionB -> do
Region
region <- BufferM Region
regionB
Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
region RegionStyle
LineWise
parseFullRange :: P.Parser (BufferM Region)
parseFullRange :: Parser Text (BufferM Region)
parseFullRange = Char -> Parser Text Char
P.char Char
'%' Parser Text Char
-> Parser Text (BufferM Region) -> Parser Text (BufferM Region)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufferM Region -> Parser Text (BufferM Region)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextUnit -> BufferM Region
regionOfB TextUnit
Document)
parsePointRange :: P.Parser (BufferM Region)
parsePointRange :: Parser Text (BufferM Region)
parsePointRange = do
BufferM Point
p1 <- Parser (BufferM Point)
parseSinglePoint
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
P.char Char
','
BufferM Point
p2 <- BufferM Point -> Parser (BufferM Point)
parseSinglePoint2 BufferM Point
p1
BufferM Region -> Parser Text (BufferM Region)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Region -> Parser Text (BufferM Region))
-> BufferM Region -> Parser Text (BufferM Region)
forall a b. (a -> b) -> a -> b
$ do
Point
p1' <- BufferM Point
p1
Point
p2' <- BufferM Point
p2
Region -> BufferM Region
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> BufferM Region) -> Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion (Point -> Point -> Point
forall a. Ord a => a -> a -> a
min Point
p1' Point
p2') (Point -> Point -> Point
forall a. Ord a => a -> a -> a
max Point
p1' Point
p2')
parseSinglePoint :: P.Parser (BufferM Point)
parseSinglePoint :: Parser (BufferM Point)
parseSinglePoint = Parser (BufferM Point)
parseSingleMark Parser (BufferM Point)
-> Parser (BufferM Point) -> Parser (BufferM Point)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (BufferM Point)
parseLinePoint
parseSinglePoint2 :: BufferM Point -> P.Parser (BufferM Point)
parseSinglePoint2 :: BufferM Point -> Parser (BufferM Point)
parseSinglePoint2 BufferM Point
ptB = BufferM Point -> Parser (BufferM Point)
parseEndOfLine BufferM Point
ptB Parser (BufferM Point)
-> Parser (BufferM Point) -> Parser (BufferM Point)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (BufferM Point)
parseSinglePoint
parseSingleMark :: P.Parser (BufferM Point)
parseSingleMark :: Parser (BufferM Point)
parseSingleMark = Char -> Parser Text Char
P.char Char
'\'' Parser Text Char
-> Parser (BufferM Point) -> Parser (BufferM Point)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser (BufferM Point)
parseSelMark Parser (BufferM Point)
-> Parser (BufferM Point) -> Parser (BufferM Point)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (BufferM Point)
parseNormMark)
parseNormMark :: P.Parser (BufferM Point)
parseNormMark :: Parser (BufferM Point)
parseNormMark = do
Char
c <- Parser Text Char
P.anyChar
BufferM Point -> Parser (BufferM Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Point -> Parser (BufferM Point))
-> BufferM Point -> Parser (BufferM Point)
forall a b. (a -> b) -> a -> b
$ String -> BufferM (Maybe Mark)
mayGetMarkB [Char
c] BufferM (Maybe Mark)
-> (Maybe Mark -> BufferM Point) -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Mark
Nothing -> String -> BufferM Point
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BufferM Point) -> String -> BufferM Point
forall a b. (a -> b) -> a -> b
$ String
"Mark " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not set"
Just Mark
mark -> Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Lens' FBuffer Point
markPointA Mark
mark)
parseSelMark :: P.Parser (BufferM Point)
parseSelMark :: Parser (BufferM Point)
parseSelMark = do
Char
c <- (Char -> Bool) -> Parser Text Char
P.satisfy ((Char -> Bool) -> Parser Text Char)
-> (Char -> Bool) -> Parser Text Char
forall a b. (a -> b) -> a -> b
$ String -> Char -> Bool
P.inClass String
"<>"
BufferM Point -> Parser (BufferM Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Point -> Parser (BufferM Point))
-> BufferM Point -> Parser (BufferM Point)
forall a b. (a -> b) -> a -> b
$ if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' then BufferM Point
getSelectionMarkPointB else BufferM Point
pointB
parseEndOfLine :: BufferM Point -> P.Parser (BufferM Point)
parseEndOfLine :: BufferM Point -> Parser (BufferM Point)
parseEndOfLine BufferM Point
ptB = Char -> Parser Text Char
P.char Char
'$' Parser Text Char
-> Parser (BufferM Point) -> Parser (BufferM Point)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufferM Point -> Parser (BufferM Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Point
ptB BufferM Point -> (Point -> BufferM Point) -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Point
eolPointB)
parseLinePoint :: P.Parser (BufferM Point)
parseLinePoint :: Parser (BufferM Point)
parseLinePoint = Parser (BufferM Point)
parseCurrentLinePoint Parser (BufferM Point)
-> Parser (BufferM Point) -> Parser (BufferM Point)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (BufferM Point)
parseNormalLinePoint
parseCurrentLinePoint :: P.Parser (BufferM Point)
parseCurrentLinePoint :: Parser (BufferM Point)
parseCurrentLinePoint = do
Maybe Int
relative <- (Maybe Int
forall a. Maybe a
Nothing Maybe Int -> Parser Text Char -> Parser (Maybe Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
P.char Char
'.' Parser (Maybe Int) -> Parser (Maybe Int) -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (Parser (Maybe Int) -> Parser (Maybe Int))
-> Parser (Maybe Int) -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$
do () () -> Parser Text Char -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
P.char Char
'.' Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser Text ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Char
c <- (Char -> Bool) -> Parser Text Char
P.satisfy ((Char -> Bool) -> Parser Text Char)
-> (Char -> Bool) -> Parser Text Char
forall a b. (a -> b) -> a -> b
$ String -> Char -> Bool
P.inClass String
"+-"
(Int
i :: Int) <- String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser Text String -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.digit
Maybe Int -> Parser (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> Parser (Maybe Int))
-> (Int -> Maybe Int) -> Int -> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Parser (Maybe Int)) -> Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' then Int
i else -Int
i
case Maybe Int
relative of
Maybe Int
Nothing -> BufferM Point -> Parser (BufferM Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Point -> Parser (BufferM Point))
-> BufferM Point -> Parser (BufferM Point)
forall a b. (a -> b) -> a -> b
$ BufferM Point
pointB BufferM Point -> (Point -> BufferM Point) -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM Point
solPointB
Just Int
offset -> BufferM Point -> Parser (BufferM Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Point -> Parser (BufferM Point))
-> BufferM Point -> Parser (BufferM Point)
forall a b. (a -> b) -> a -> b
$ do
Int
ln <- BufferM Int
curLn
BufferM Point -> BufferM Point
forall a. BufferM a -> BufferM a
savingPointB (BufferM Point -> BufferM Point) -> BufferM Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) BufferM Int -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB
parseNormalLinePoint :: P.Parser (BufferM Point)
parseNormalLinePoint :: Parser (BufferM Point)
parseNormalLinePoint = do
Int
ln <- String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser Text String -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.digit
BufferM Point -> Parser (BufferM Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferM Point -> Parser (BufferM Point))
-> (BufferM Point -> BufferM Point)
-> BufferM Point
-> Parser (BufferM Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferM Point -> BufferM Point
forall a. BufferM a -> BufferM a
savingPointB (BufferM Point -> Parser (BufferM Point))
-> BufferM Point -> Parser (BufferM Point)
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
ln BufferM Int -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB
data BoolOptionAction = BoolOptionSet !Bool | BoolOptionInvert | BoolOptionAsk
parseBoolOption :: T.Text -> (BoolOptionAction -> Action) -> EventString
-> Maybe ExCommand
parseBoolOption :: Text
-> (BoolOptionAction -> Action) -> EventString -> Maybe ExCommand
parseBoolOption Text
name BoolOptionAction -> Action
action = Parser ExCommand -> EventString -> Maybe ExCommand
parse (Parser ExCommand -> EventString -> Maybe ExCommand)
-> Parser ExCommand -> EventString -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ do
Parser Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser Text ()) -> Parser Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
P.string Text
"set "
[Text]
nos <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string Text
"no")
[Text]
invs <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string Text
"inv")
Parser Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser Text ()) -> Parser Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
P.string Text
name
[Text]
bangs <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string Text
"!")
[Text]
qs <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string Text
"?")
ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$ ExCommand
pureExCommand {
cmdShow :: Text
cmdShow = [Text] -> Text
T.concat [ Text
"set "
, [Text] -> Text
T.concat [Text]
nos
, Text
name
, [Text] -> Text
T.concat [Text]
bangs
, [Text] -> Text
T.concat [Text]
qs ]
, cmdAction :: Action
cmdAction = BoolOptionAction -> Action
action (BoolOptionAction -> Action) -> BoolOptionAction -> Action
forall a b. (a -> b) -> a -> b
$
case ([Text] -> Bool) -> [[Text]] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Text]
qs, [Text]
bangs, [Text]
invs, [Text]
nos] of
[Bool
True, Bool
_, Bool
_, Bool
_] -> BoolOptionAction
BoolOptionAsk
[Bool
_, Bool
True, Bool
_, Bool
_] -> BoolOptionAction
BoolOptionInvert
[Bool
_, Bool
_, Bool
True, Bool
_] -> BoolOptionAction
BoolOptionInvert
[Bool
_, Bool
_, Bool
_, Bool
True] -> Bool -> BoolOptionAction
BoolOptionSet Bool
False
[Bool]
_ -> Bool -> BoolOptionAction
BoolOptionSet Bool
True
}
data TextOptionAction = TextOptionSet !T.Text | TextOptionAsk
parseTextOption :: T.Text -> (TextOptionAction -> Action) -> EventString
-> Maybe ExCommand
parseTextOption :: Text
-> (TextOptionAction -> Action) -> EventString -> Maybe ExCommand
parseTextOption Text
name TextOptionAction -> Action
action = Parser ExCommand -> EventString -> Maybe ExCommand
parse (Parser ExCommand -> EventString -> Maybe ExCommand)
-> Parser ExCommand -> EventString -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ do
Parser Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser Text ()) -> Parser Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
P.string Text
"set "
Parser Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser Text ()) -> Parser Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
P.string Text
name
Maybe Text
maybeNewValue <- Maybe Text -> Parser Text (Maybe Text) -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
P.option Maybe Text
forall a. Maybe a
Nothing (Parser Text (Maybe Text) -> Parser Text (Maybe Text))
-> Parser Text (Maybe Text) -> Parser Text (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Parser Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Parser Text String -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text String -> Parser Text ())
-> Parser Text String -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text Char
P.space
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
P.char Char
'='
Parser Text String -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text String -> Parser Text ())
-> Parser Text String -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text Char
P.space
String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text Char
P.anyChar
ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$ ExCommand
pureExCommand
{ cmdShow :: Text
cmdShow = [Text] -> Text
T.concat [ Text
"set "
, Text
name
, Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
maybeNewValue
]
, cmdAction :: Action
cmdAction = TextOptionAction -> Action
action (TextOptionAction -> Action) -> TextOptionAction -> Action
forall a b. (a -> b) -> a -> b
$ TextOptionAction
-> (Text -> TextOptionAction) -> Maybe Text -> TextOptionAction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextOptionAction
TextOptionAsk Text -> TextOptionAction
TextOptionSet Maybe Text
maybeNewValue
}
removePwd :: T.Text -> YiM T.Text
removePwd :: Text -> YiM Text
removePwd Text
path = do
Text
pwd' <- String -> Text
T.pack (String -> Text) -> YiM String -> YiM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
getCurrentDirectory
Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> YiM Text) -> Text -> YiM Text
forall a b. (a -> b) -> a -> b
$! if Text
pwd' Text -> Char -> Text
`T.snoc` Char
'/' Text -> Text -> Bool
`T.isPrefixOf` Text
path
then Int -> Text -> Text
T.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
pwd') Text
path
else Text
path
filenameComplete :: T.Text -> YiM [T.Text]
filenameComplete :: Text -> YiM [Text]
filenameComplete Text
f = if Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"%"
then
(Editor -> NonEmpty BufferRef) -> YiM (NonEmpty BufferRef)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> NonEmpty BufferRef
bufferStack YiM (NonEmpty BufferRef)
-> (NonEmpty BufferRef -> YiM [Text]) -> YiM [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
BufferRef
_ :| [] -> do
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"filenameComplete: Expected to see minibuffer!"
[Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
BufferRef
_ :| BufferRef
bufferRef : [BufferRef]
_ -> do
Text
currentFileName <- (String -> Text) -> YiM String -> YiM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (YiM String -> YiM Text)
-> (BufferM String -> YiM String) -> BufferM String -> YiM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> BufferM String -> YiM String
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
bufferRef (BufferM String -> YiM Text) -> BufferM String -> YiM Text
forall a b. (a -> b) -> a -> b
$
(BufferFileInfo -> String)
-> BufferM BufferFileInfo -> BufferM String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BufferFileInfo -> String
bufInfoFileName BufferM BufferFileInfo
bufInfoB
let sanitizedFileName :: Text
sanitizedFileName = if Text
"//" Text -> Text -> Bool
`T.isPrefixOf` Text
currentFileName
then Char
'/' Char -> Text -> Text
`T.cons` Text
currentFileName
else Text
currentFileName
Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> YiM Text -> YiM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> YiM Text
removePwd Text
sanitizedFileName
else do
[Text]
files <- Maybe Text -> Text -> YiM [Text]
matchingFileNames Maybe Text
forall a. Maybe a
Nothing Text
f
case [Text]
files of
[] -> [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Text
x] -> Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> YiM Text -> YiM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> YiM Text
removePwd Text
x
[Text]
xs -> [YiM Text] -> YiM [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([YiM Text] -> YiM [Text]) -> [YiM Text] -> YiM [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> YiM Text) -> [Text] -> [YiM Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> YiM Text
removePwd [Text]
xs
forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m ()
forAllBuffers :: (BufferRef -> m ()) -> m ()
forAllBuffers BufferRef -> m ()
f = (Editor -> NonEmpty BufferRef) -> m (NonEmpty BufferRef)
forall (m :: * -> *) a. MonadEditor m => (Editor -> a) -> m a
readEditor Editor -> NonEmpty BufferRef
bufferStack m (NonEmpty BufferRef) -> (NonEmpty BufferRef -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(BufferRef
b :| [BufferRef]
bs) -> BufferRef -> m ()
f BufferRef
b m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (BufferRef -> m ()) -> [BufferRef] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BufferRef -> m ()
f [BufferRef]
bs
pureExCommand :: ExCommand
pureExCommand :: ExCommand
pureExCommand = ExCommand :: YiM [Text] -> Bool -> Action -> Bool -> Text -> ExCommand
ExCommand {
cmdIsPure :: Bool
cmdIsPure = Bool
True
, cmdComplete :: YiM [Text]
cmdComplete = [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
, cmdAcceptsRange :: Bool
cmdAcceptsRange = Bool
False
, cmdAction :: Action
cmdAction = Action
forall a. HasCallStack => a
undefined
, cmdShow :: Text
cmdShow = Text
forall a. HasCallStack => a
undefined
}
impureExCommand :: ExCommand
impureExCommand :: ExCommand
impureExCommand = ExCommand
pureExCommand { cmdIsPure :: Bool
cmdIsPure = Bool
False }
errorEditor :: T.Text -> EditorM ()
errorEditor :: Text -> EditorM ()
errorEditor Text
s = Status -> EditorM ()
forall (m :: * -> *). MonadEditor m => Status -> m ()
printStatus ([Text
"error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s], UIStyle -> Style
errorStyle)
errorNoWrite :: EditorM ()
errorNoWrite :: EditorM ()
errorNoWrite = Text -> EditorM ()
errorEditor Text
"No write since last change (add ! to override)"
commandArgs :: P.Parser [T.Text]
commandArgs :: Parser Text [Text]
commandArgs = Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text
commandArg
commandArg :: P.Parser T.Text
commandArg :: Parser Text
commandArg = ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Parser Text [Text] -> Parser Text)
-> Parser Text [Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.space Parser Text String -> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Text]
normArg
normArg :: P.Parser [T.Text]
normArg :: Parser Text [Text]
normArg = Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 (Parser Text -> Parser Text [Text])
-> Parser Text -> Parser Text [Text]
forall a b. (a -> b) -> a -> b
$
Char -> Parser Text
quoteArg Char
'\"'
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text
quoteArg Char
'\"'
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Text
T.singleton (Char -> Text) -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char
escapeChar
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Text
T.singleton (Char -> Text) -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Char
P.satisfy (String -> Char -> Bool
P.notInClass String
" \"\'\\")
quoteArg :: Char -> P.Parser T.Text
quoteArg :: Char -> Parser Text
quoteArg Char
delim = (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Parser Text String -> Parser Text)
-> Parser Text String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
P.char Char
delim
Parser Text Char -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 ((Char -> Bool) -> Parser Text Char
P.satisfy (String -> Char -> Bool
P.notInClass (Char
delimChar -> String -> String
forall a. a -> [a] -> [a]
:String
"\\")) Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Char
escapeChar)
Parser Text String -> Parser Text Char -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
P.char Char
delim
escapeChar :: P.Parser Char
escapeChar :: Parser Text Char
escapeChar = Char -> Parser Text Char
P.char Char
'\\' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Char
P.satisfy (String -> Char -> Bool
P.inClass String
" \"\'\\")
needsSaving :: BufferRef -> YiM Bool
needsSaving :: BufferRef -> YiM Bool
needsSaving = BufferRef -> YiM (Maybe FBuffer)
forall (m :: * -> *).
MonadEditor m =>
BufferRef -> m (Maybe FBuffer)
findBuffer (BufferRef -> YiM (Maybe FBuffer))
-> (Maybe FBuffer -> YiM Bool) -> BufferRef -> YiM Bool
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> YiM Bool -> (FBuffer -> YiM Bool) -> Maybe FBuffer -> YiM Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> YiM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) FBuffer -> YiM Bool
deservesSave