{-# 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 :: Parser ExCommand
parser (Ev s :: 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 nameParser :: Parser a
nameParser argumentParser :: a -> Bool -> Maybe Int -> Parser ExCommand
argumentParser (Ev s :: 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 nameParser :: Parser a
nameParser argumentParser :: a -> Bool -> Parser ExCommand
argumentParser (Ev s :: 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 "!" 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
$ \regionB :: 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 '%' 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 ','
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 ptB :: 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 '\'' 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
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
$ "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
<> " not set"
Just mark :: 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 "<>"
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
== '<' then BufferM Point
getSelectionMarkPointB else BufferM Point
pointB
parseEndOfLine :: BufferM Point -> P.Parser (BufferM Point)
parseEndOfLine :: BufferM Point -> Parser (BufferM Point)
parseEndOfLine ptB :: BufferM Point
ptB = Char -> Parser Text Char
P.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 '.' 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 '.' 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 "+-"
(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
== '+' then Int
i else -Int
i
case Maybe Int
relative of
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 offset :: 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 name :: Text
name action :: 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 "set "
[Text]
nos <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string "no")
[Text]
invs <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string "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]
qs <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Text -> Parser Text
P.string "?")
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 [ "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
[True, _, _, _] -> BoolOptionAction
BoolOptionAsk
[_, True, _, _] -> BoolOptionAction
BoolOptionInvert
[_, _, True, _] -> BoolOptionAction
BoolOptionInvert
[_, _, _, True] -> Bool -> BoolOptionAction
BoolOptionSet Bool
False
_ -> 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 name :: Text
name action :: 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 "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 '='
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 [ "set "
, Text
name
, Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (" = " 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 path :: 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` '/' Text -> Text -> Bool
`T.isPrefixOf` Text
path
then Int -> Text -> Text
T.drop (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 f :: Text
f = if Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "%"
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
_ :| [] -> do
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg "filenameComplete: Expected to see minibuffer!"
[Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ :| 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 -> Bool
`T.isPrefixOf` Text
currentFileName
then '/' 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 []
[x :: 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
xs :: [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 f :: 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
>>= \(b :: BufferRef
b :| bs :: [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 s :: Text
s = Status -> EditorM ()
forall (m :: * -> *). MonadEditor m => Status -> m ()
printStatus (["error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s], UIStyle -> Style
errorStyle)
errorNoWrite :: EditorM ()
errorNoWrite :: EditorM ()
errorNoWrite = Text -> EditorM ()
errorEditor "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 '\"'
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text
quoteArg '\"'
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 " \"\'\\")
quoteArg :: Char -> P.Parser T.Text
quoteArg :: Char -> Parser Text
quoteArg delim :: 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]
:"\\")) 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 '\\' 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 " \"\'\\")
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