{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.Common
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Implements common 'ExCommand's for the Vim keymap.

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)

-- TODO this kind of thing is exactly where it makes sense to
-- *not* use parseOnly but its easier to have compatibility with
-- the old parsec-based interface for now.

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
                      -- ^ The command name parser.
                      -> (a -> Bool
                          -> Maybe Int
                          -> P.Parser ExCommand)
                      -- ^ A parser for the remaining command arguments.
                      -> EventString
                      -- ^ The string to parse.
                      -> 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
              -- ^ The command name parser.
              -> (a -> Bool -> P.Parser ExCommand)
              -- ^ A parser for the remaining command arguments.
              -> EventString
              -- ^ The string to parse.
              -> 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

-- | Some of the parse rules for the second point actually depend
-- on the first point. If parse rule succeeds this can result
-- in the first BufferM Point having to be run twice but this
-- probably isn't a big deal.
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

-- | Parse a single mark, or a selection mark (< or >)
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)

-- | Parse a normal mark (non-system)
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)

-- | Parse selection marks.
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

-- | Parses end of line, $, only valid for 2nd point.
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)

-- | Parses a numeric line or ".+k", k relative to current
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

-- | Parses .+-k
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

-- | Parses a line number
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
    -- current buffer is minibuffer
    -- actual file is in the second buffer in bufferStack
    (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 }


-- | Show an error on the status line.
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)


-- | Show the common error message about an unsaved file on the status line.
errorNoWrite :: EditorM ()
errorNoWrite :: EditorM ()
errorNoWrite = Text -> EditorM ()
errorEditor Text
"No write since last change (add ! to override)"

-- | Useful parser for any Ex command that acts kind of like a shell
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

-- | Parse a single command, with a space in front
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

-- | Unquoted arg, allows for escaping of \, ", ', and space. Includes quoted arg
-- as a subset, because of things like aa"bbb"
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
" \"\'\\")

-- | Quoted arg with char delim. Allows same escapes, but doesn't require escaping
-- of the opposite kind or space. However, it does allow escaping opposite kind like
-- normal, as well as allowing escaping of space (is this normal behavior?).
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

-- | Parser for a single escape character
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