{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Command where
import Control.Concurrent (MVar,newEmptyMVar,putMVar,takeMVar)
import Control.Exception (SomeException)
import Lens.Micro.Platform ((.=))
import Control.Monad (void)
import Control.Monad.Base (liftBase)
import Data.Binary (Binary)
import Data.Default (Default)
import qualified Data.Text as T (Text, init, filter, last, length, unpack)
import Data.Typeable (Typeable)
import System.Exit (ExitCode (..))
import Yi.Buffer (BufferId (MemBuffer), BufferRef, identA, setMode)
import Yi.Core (startSubprocess)
import Yi.Editor
import Yi.Keymap (YiM, withUI)
import Yi.MiniBuffer
import qualified Yi.Mode.Compilation as Compilation (mode)
import qualified Yi.Mode.Interactive as Interactive (mode,spawnProcess)
import Yi.Monad (maybeM)
import Yi.Process (runShellCommand, shellFileName)
import qualified Yi.Rope as R (fromText)
import Yi.Types (YiVariable)
import Yi.UI.Common (reloadProject)
import Yi.Utils (io)
changeBufferNameE :: YiM ()
changeBufferNameE :: YiM ()
changeBufferNameE = Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"New buffer name:" Text -> YiM ()
strFun
where
strFun :: T.Text -> YiM ()
strFun :: Text -> YiM ()
strFun = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> (Text -> BufferM ()) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter FBuffer FBuffer BufferId BufferId -> BufferId -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
(.=) ASetter FBuffer FBuffer BufferId BufferId
forall c. HasAttributes c => Lens' c BufferId
identA (BufferId -> BufferM ())
-> (Text -> BufferId) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BufferId
MemBuffer
shellCommandE :: YiM ()
shellCommandE :: YiM ()
shellCommandE = Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"Shell command:" Text -> YiM ()
shellCommandV
shellCommandV :: T.Text -> YiM ()
shellCommandV :: Text -> YiM ()
shellCommandV Text
cmd = do
(ExitCode
exitCode,Text
cmdOut,Text
cmdErr) <- IO (ExitCode, Text, Text) -> YiM (ExitCode, Text, Text)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ExitCode, Text, Text) -> YiM (ExitCode, Text, Text))
-> (String -> IO (ExitCode, Text, Text))
-> String
-> YiM (ExitCode, Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (ExitCode, Text, Text)
forall a c. ListLikeProcessIO a c => String -> IO (ExitCode, a, a)
runShellCommand (String -> YiM (ExitCode, Text, Text))
-> String -> YiM (ExitCode, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
cmd
case ExitCode
exitCode of
ExitCode
ExitSuccess -> if Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
cmdOut) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
17
then EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (EditorM BufferRef -> EditorM ()) -> EditorM BufferRef -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> YiM ()) -> EditorM BufferRef -> YiM ()
forall a b. (a -> b) -> a -> b
$
BufferId -> YiString -> EditorM BufferRef
newBufferE (Text -> BufferId
MemBuffer Text
"Shell Command Output")
(Text -> YiString
R.fromText Text
cmdOut)
else Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ case Text
cmdOut of
Text
"" -> Text
"(Shell command with no output)"
Text
xs -> if Text -> Char
T.last Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Text -> Text
T.init Text
xs else Text
xs
ExitFailure Int
_ -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
cmdErr
newtype CabalBuffer = CabalBuffer {CabalBuffer -> Maybe BufferRef
cabalBuffer :: Maybe BufferRef}
deriving (CabalBuffer
CabalBuffer -> Default CabalBuffer
forall a. a -> Default a
def :: CabalBuffer
$cdef :: CabalBuffer
Default, Typeable, Get CabalBuffer
[CabalBuffer] -> Put
CabalBuffer -> Put
(CabalBuffer -> Put)
-> Get CabalBuffer -> ([CabalBuffer] -> Put) -> Binary CabalBuffer
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CabalBuffer] -> Put
$cputList :: [CabalBuffer] -> Put
get :: Get CabalBuffer
$cget :: Get CabalBuffer
put :: CabalBuffer -> Put
$cput :: CabalBuffer -> Put
Binary)
instance YiVariable CabalBuffer
cabalConfigureE :: CommandArguments -> YiM ()
cabalConfigureE :: CommandArguments -> YiM ()
cabalConfigureE = Text
-> (Either SomeException ExitCode -> YiM ())
-> CommandArguments
-> YiM ()
forall x.
Text
-> (Either SomeException ExitCode -> YiM x)
-> CommandArguments
-> YiM ()
cabalRun Text
"configure" Either SomeException ExitCode -> YiM ()
configureExit
configureExit :: Either SomeException ExitCode -> YiM ()
configureExit :: Either SomeException ExitCode -> YiM ()
configureExit (Right ExitCode
ExitSuccess) = String -> YiM ()
reloadProjectE String
"."
configureExit Either SomeException ExitCode
_ = () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reloadProjectE :: String -> YiM ()
reloadProjectE :: String -> YiM ()
reloadProjectE String
s = (UI Editor -> IO ()) -> YiM ()
forall a. (UI Editor -> IO a) -> YiM a
withUI ((UI Editor -> IO ()) -> YiM ()) -> (UI Editor -> IO ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \UI Editor
ui -> UI Editor -> String -> IO ()
forall e. UI e -> String -> IO ()
reloadProject UI Editor
ui String
s
buildRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun :: Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun Text
cmd [Text]
args Either SomeException ExitCode -> YiM x
onExit = YiM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
BufferRef
b <- String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
forall x.
String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
startSubprocess (Text -> String
T.unpack Text
cmd) (Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
args) Either SomeException ExitCode -> YiM x
onExit
(BufferRef -> YiM ()) -> Maybe BufferRef -> YiM ()
forall (m :: * -> *) x. Monad m => (x -> m ()) -> Maybe x -> m ()
maybeM BufferRef -> YiM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer (Maybe BufferRef -> YiM ()) -> YiM (Maybe BufferRef) -> YiM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CabalBuffer -> Maybe BufferRef
cabalBuffer (CabalBuffer -> Maybe BufferRef)
-> YiM CabalBuffer -> YiM (Maybe BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiM CabalBuffer
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
CabalBuffer -> YiM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (CabalBuffer -> YiM ()) -> CabalBuffer -> YiM ()
forall a b. (a -> b) -> a -> b
$ Maybe BufferRef -> CabalBuffer
CabalBuffer (Maybe BufferRef -> CabalBuffer) -> Maybe BufferRef -> CabalBuffer
forall a b. (a -> b) -> a -> b
$ BufferRef -> Maybe BufferRef
forall a. a -> Maybe a
Just BufferRef
b
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Mode (Tree (Tok Token)) -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode (Tree (Tok Token))
Compilation.mode
() -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
interactiveRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
interactiveRun :: Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
interactiveRun Text
cmd [Text]
args Either SomeException ExitCode -> YiM x
onExit = YiM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
MVar BufferRef
bc <- IO (MVar BufferRef) -> YiM (MVar BufferRef)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (MVar BufferRef) -> YiM (MVar BufferRef))
-> IO (MVar BufferRef) -> YiM (MVar BufferRef)
forall a b. (a -> b) -> a -> b
$ IO (MVar BufferRef)
forall a. IO (MVar a)
newEmptyMVar
BufferRef
b <- String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
forall x.
String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
startSubprocess (Text -> String
T.unpack Text
cmd) (Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
args) ((Either SomeException ExitCode -> YiM x) -> YiM BufferRef)
-> (Either SomeException ExitCode -> YiM x) -> YiM BufferRef
forall a b. (a -> b) -> a -> b
$ \Either SomeException ExitCode
r -> do
BufferRef
b <- IO BufferRef -> YiM BufferRef
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO BufferRef -> YiM BufferRef) -> IO BufferRef -> YiM BufferRef
forall a b. (a -> b) -> a -> b
$ MVar BufferRef -> IO BufferRef
forall a. MVar a -> IO a
takeMVar MVar BufferRef
bc
BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Mode (Tree (Tok Token)) -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode (Tree (Tok Token))
Compilation.mode
Either SomeException ExitCode -> YiM x
onExit Either SomeException ExitCode
r
(BufferRef -> YiM ()) -> Maybe BufferRef -> YiM ()
forall (m :: * -> *) x. Monad m => (x -> m ()) -> Maybe x -> m ()
maybeM BufferRef -> YiM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer (Maybe BufferRef -> YiM ()) -> YiM (Maybe BufferRef) -> YiM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CabalBuffer -> Maybe BufferRef
cabalBuffer (CabalBuffer -> Maybe BufferRef)
-> YiM CabalBuffer -> YiM (Maybe BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiM CabalBuffer
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Mode (Tree (Tok Token)) -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode (Tree (Tok Token))
Interactive.mode
IO () -> YiM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ MVar BufferRef -> BufferRef -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar BufferRef
bc BufferRef
b
() -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
selectRunner :: T.Text -> T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
selectRunner :: Text
-> Text
-> [Text]
-> (Either SomeException ExitCode -> YiM x)
-> YiM ()
selectRunner Text
command = if Text
command Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"eval",Text
"exec",Text
"ghci",Text
"repl",Text
"runghc",Text
"runhaskell",Text
"script"]
then Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
interactiveRun
else Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun
makeBuild :: CommandArguments -> YiM ()
makeBuild :: CommandArguments -> YiM ()
makeBuild (CommandArguments [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM ()) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun Text
"make" [Text]
args (YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Either SomeException ExitCode -> YiM ())
-> YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
cabalRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
cabalRun :: Text
-> (Either SomeException ExitCode -> YiM x)
-> CommandArguments
-> YiM ()
cabalRun Text
cmd Either SomeException ExitCode -> YiM x
onExit (CommandArguments [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
runner Text
"cabal" (Text
cmdText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
args) Either SomeException ExitCode -> YiM x
onExit where
runner :: Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
runner = Text
-> Text
-> [Text]
-> (Either SomeException ExitCode -> YiM x)
-> YiM ()
forall x.
Text
-> Text
-> [Text]
-> (Either SomeException ExitCode -> YiM x)
-> YiM ()
selectRunner Text
cmd
makeRun :: (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
makeRun :: (Either SomeException ExitCode -> YiM x)
-> CommandArguments -> YiM ()
makeRun Either SomeException ExitCode -> YiM x
onExit (CommandArguments [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun Text
"make" [Text]
args Either SomeException ExitCode -> YiM x
onExit
cabalBuildE :: CommandArguments -> YiM ()
cabalBuildE :: CommandArguments -> YiM ()
cabalBuildE = Text
-> (Either SomeException ExitCode -> YiM ())
-> CommandArguments
-> YiM ()
forall x.
Text
-> (Either SomeException ExitCode -> YiM x)
-> CommandArguments
-> YiM ()
cabalRun Text
"build" (YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Either SomeException ExitCode -> YiM ())
-> YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
makeBuildE :: CommandArguments -> YiM ()
makeBuildE :: CommandArguments -> YiM ()
makeBuildE = (Either SomeException ExitCode -> YiM ())
-> CommandArguments -> YiM ()
forall x.
(Either SomeException ExitCode -> YiM x)
-> CommandArguments -> YiM ()
makeRun (YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Either SomeException ExitCode -> YiM ())
-> YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
shell :: YiM BufferRef
shell :: YiM BufferRef
shell = do
String
sh <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
shellFileName
String -> [String] -> YiM BufferRef
Interactive.spawnProcess String
sh [String
"-i"]
searchSources :: String ::: RegexTag -> YiM ()
searchSources :: (String ::: RegexTag) -> YiM ()
searchSources = (String ::: FilePatternTag) -> (String ::: RegexTag) -> YiM ()
grepFind (String -> String ::: FilePatternTag
forall t doc. t -> t ::: doc
Doc String
"*.hs")
grepFind :: String ::: FilePatternTag -> String ::: RegexTag -> YiM ()
grepFind :: (String ::: FilePatternTag) -> (String ::: RegexTag) -> YiM ()
grepFind (Doc String
filePattern) (Doc String
searchedRegex) = YiM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
YiM BufferRef -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM BufferRef -> YiM ()) -> YiM BufferRef -> YiM ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> (Either SomeException ExitCode -> YiM ())
-> YiM BufferRef
forall x.
String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
startSubprocess String
"find" [String
".",
String
"-name", String
"_darcs", String
"-prune", String
"-o",
String
"-name", String
filePattern, String
"-exec", String
"grep", String
"-Hnie", String
searchedRegex, String
"{}", String
";"] (YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Either SomeException ExitCode -> YiM ())
-> YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Mode (Tree (Tok Token)) -> BufferM ()
forall syntax. Mode syntax -> BufferM ()
setMode Mode (Tree (Tok Token))
Compilation.mode
() -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
stackCommandE :: T.Text -> CommandArguments -> YiM ()
stackCommandE :: Text -> CommandArguments -> YiM ()
stackCommandE Text
cmd = Text
-> (Either SomeException ExitCode -> YiM ())
-> CommandArguments
-> YiM ()
forall x.
Text
-> (Either SomeException ExitCode -> YiM x)
-> CommandArguments
-> YiM ()
stackRun Text
cmd (YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Either SomeException ExitCode -> YiM ())
-> YiM () -> Either SomeException ExitCode -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
stackRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
stackRun :: Text
-> (Either SomeException ExitCode -> YiM x)
-> CommandArguments
-> YiM ()
stackRun Text
cmd Either SomeException ExitCode -> YiM x
onExit (CommandArguments [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
runner Text
"stack" (Text
cmdText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
args) Either SomeException ExitCode -> YiM x
onExit where
runner :: Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
runner = Text
-> Text
-> [Text]
-> (Either SomeException ExitCode -> YiM x)
-> YiM ()
forall x.
Text
-> Text
-> [Text]
-> (Either SomeException ExitCode -> YiM x)
-> YiM ()
selectRunner Text
cmd