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
import Control.Lens (use)
import Control.Monad
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid
import qualified Data.Text as T
import System.Directory
import qualified Text.ParserCombinators.Parsec as P
import Text.Read (readMaybe)
import Yi.Buffer
import Yi.Editor
import Yi.File
import Yi.Keymap
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Ex.Types
import Yi.Misc
import Yi.Monad
import Yi.Style (errorStyle)
import Yi.Utils
parse :: P.GenParser Char () ExCommand -> EventString -> Maybe ExCommand
parse parser (Ev s) =
either (const Nothing) Just (P.parse parser "" $ T.unpack s)
parseWithBangAndCount :: P.GenParser Char () a
-> (a -> Bool
-> Maybe Int
-> P.GenParser Char () ExCommand)
-> EventString
-> Maybe ExCommand
parseWithBangAndCount nameParser argumentParser (Ev s) =
either (const Nothing) Just (P.parse parser "" $ T.unpack s)
where
parser = do
mcount <- parseCount
a <- nameParser
bang <- parseBang
argumentParser a bang mcount
parseWithBang :: P.GenParser Char () a
-> (a -> Bool -> P.GenParser Char () ExCommand)
-> EventString
-> Maybe ExCommand
parseWithBang nameParser argumentParser (Ev s) =
either (const Nothing) Just (P.parse parser "" $ T.unpack s)
where
parser = do
a <- nameParser
bang <- parseBang
argumentParser a bang
parseBang :: P.GenParser Char () Bool
parseBang = P.string "!" *> return True <|> return False
parseCount :: P.GenParser Char () (Maybe Int)
parseCount = readMaybe <$> P.many P.digit
parseRange :: P.GenParser Char s (Maybe (BufferM Region))
parseRange = fmap Just parseFullRange
<|> fmap Just parsePointRange
<|> return Nothing
parseFullRange :: P.GenParser Char s (BufferM Region)
parseFullRange = P.char '%' *> return (regionOfB Document)
parsePointRange :: P.GenParser Char s (BufferM Region)
parsePointRange = do
p1 <- parseSinglePoint
void $ P.char ','
p2 <- parseSinglePoint2 p1
return $ do
p1' <- p1
p2' <- p2
return $ mkRegion (min p1' p2') (max p1' p2')
parseSinglePoint :: P.GenParser Char s (BufferM Point)
parseSinglePoint = parseSingleMark <|> parseLinePoint
parseSinglePoint2 :: BufferM Point -> P.GenParser Char s (BufferM Point)
parseSinglePoint2 ptB = parseEndOfLine ptB <|> parseSinglePoint
parseSingleMark :: P.GenParser Char s (BufferM Point)
parseSingleMark = P.char '\'' *> (parseSelMark <|> parseNormMark)
parseNormMark :: P.GenParser Char s (BufferM Point)
parseNormMark = do
c <- P.anyChar
return $ mayGetMarkB [c] >>= \case
Nothing -> fail $ "Mark " <> show c <> " not set"
Just mark -> use (markPointA mark)
parseSelMark :: P.GenParser Char s (BufferM Point)
parseSelMark = do
c <- P.oneOf "<>"
return $ if c == '<' then getSelectionMarkPointB else pointB
parseEndOfLine :: BufferM Point -> P.GenParser Char s (BufferM Point)
parseEndOfLine ptB = P.char '$' *> return (ptB >>= eolPointB)
parseLinePoint :: P.GenParser Char s (BufferM Point)
parseLinePoint = parseCurrentLinePoint <|> parseNormalLinePoint
parseCurrentLinePoint :: P.GenParser Char s (BufferM Point)
parseCurrentLinePoint = do
void $ P.char '.'
relative <- P.optionMaybe $ do
c <- P.oneOf "+-"
(i :: Int) <- read <$> P.many1 P.digit
return $ if c == '+' then i else i
case relative of
Nothing -> return $ pointB >>= solPointB
Just offset -> return $ do
ln <- curLn
savingPointB $ gotoLn (ln + offset) >> pointB
parseNormalLinePoint :: P.GenParser Char s (BufferM Point)
parseNormalLinePoint = do
ln <- read <$> P.many1 P.digit
return . savingPointB $ gotoLn ln >> pointB
data BoolOptionAction = BoolOptionSet !Bool | BoolOptionInvert | BoolOptionAsk
parseBoolOption :: T.Text -> (BoolOptionAction -> Action) -> EventString
-> Maybe ExCommand
parseBoolOption name action = parse $ do
void $ P.string "set "
nos <- P.many (P.string "no")
invs <- P.many (P.string "inv")
void $ P.string (T.unpack name)
bangs <- P.many (P.string "!")
qs <- P.many (P.string "?")
return $ pureExCommand {
cmdShow = T.concat [ "set "
, T.pack $ concat nos
, name
, T.pack $ concat bangs
, T.pack $ concat qs ]
, cmdAction = action $
case fmap (not . null) [qs, bangs, invs, nos] of
[True, _, _, _] -> BoolOptionAsk
[_, True, _, _] -> BoolOptionInvert
[_, _, True, _] -> BoolOptionInvert
[_, _, _, True] -> BoolOptionSet False
_ -> BoolOptionSet True
}
data TextOptionAction = TextOptionSet !T.Text | TextOptionAsk
parseTextOption :: T.Text -> (TextOptionAction -> Action) -> EventString
-> Maybe ExCommand
parseTextOption name action = parse $ do
void $ P.string "set "
void $ P.string (T.unpack name)
maybeNewValue <- P.optionMaybe $ do
void $ P.many P.space
void $ P.char '='
void $ P.many P.space
T.pack <$> P.many P.anyChar
return $ pureExCommand
{ cmdShow = T.concat [ "set "
, name
, maybe "" (" = " <>) maybeNewValue
]
, cmdAction = action $ maybe TextOptionAsk TextOptionSet maybeNewValue
}
removePwd :: T.Text -> YiM T.Text
removePwd path = do
pwd' <- T.pack <$> io getCurrentDirectory
return $! if pwd' `T.snoc` '/' `T.isPrefixOf` path
then T.drop (1 + T.length pwd') path
else path
filenameComplete :: T.Text -> YiM [T.Text]
filenameComplete f = if f == "%"
then
gets bufferStack >>= \case
_ :| [] -> do
printMsg "filenameComplete: Expected to see minibuffer!"
return []
_ :| bufferRef : _ -> do
currentFileName <- fmap T.pack . withGivenBuffer bufferRef $
fmap bufInfoFileName bufInfoB
let sanitizedFileName = if "//" `T.isPrefixOf` currentFileName
then '/' `T.cons` currentFileName
else currentFileName
return <$> removePwd sanitizedFileName
else do
files <- matchingFileNames Nothing f
case files of
[] -> return []
[x] -> return <$> removePwd x
xs -> sequence $ fmap removePwd xs
forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m ()
forAllBuffers f = readEditor bufferStack >>= \(b :| bs) -> f b >> mapM_ f bs
pureExCommand :: ExCommand
pureExCommand = ExCommand {
cmdIsPure = True
, cmdComplete = return []
, cmdAcceptsRange = False
, cmdAction = undefined
, cmdShow = undefined
}
impureExCommand :: ExCommand
impureExCommand = pureExCommand { cmdIsPure = False }
errorEditor :: T.Text -> EditorM ()
errorEditor s = printStatus (["error: " <> s], errorStyle)
errorNoWrite :: EditorM ()
errorNoWrite = errorEditor "No write since last change (add ! to override)"
commandArgs :: P.GenParser Char () [T.Text]
commandArgs = P.many commandArg
commandArg :: P.GenParser Char () T.Text
commandArg = fmap mconcat $ P.many1 P.space *> normArg
normArg :: P.GenParser Char () [T.Text]
normArg = P.many1 $
quoteArg '\"'
<|> quoteArg '\"'
<|> T.singleton <$> escapeChar
<|> T.singleton <$> P.noneOf " \"\'\\"
quoteArg :: Char -> P.GenParser Char () T.Text
quoteArg delim = fmap T.pack $ P.char delim
*> P.many1 (P.noneOf (delim:"\\") <|> escapeChar)
<* P.char delim
escapeChar :: P.GenParser Char () Char
escapeChar = P.char '\\' *> P.oneOf " \"\'\\"
needsSaving :: BufferRef -> YiM Bool
needsSaving = findBuffer >=> maybe (return False) deservesSave