{-# 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 "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 "Shell command:" Text -> YiM ()
shellCommandV
shellCommandV :: T.Text -> YiM ()
shellCommandV :: Text -> YiM ()
shellCommandV cmd :: Text
cmd = do
(exitCode :: ExitCode
exitCode,cmdOut :: Text
cmdOut,cmdErr :: 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
ExitSuccess -> if Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n') Text
cmdOut) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 "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
"" -> "(Shell command with no output)"
xs :: Text
xs -> if Text -> Char
T.last Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' then Text -> Text
T.init Text
xs else Text
xs
ExitFailure _ -> 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 "configure" Either SomeException ExitCode -> YiM ()
configureExit
configureExit :: Either SomeException ExitCode -> YiM ()
configureExit :: Either SomeException ExitCode -> YiM ()
configureExit (Right ExitSuccess) = String -> YiM ()
reloadProjectE "."
configureExit _ = () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reloadProjectE :: String -> YiM ()
reloadProjectE :: String -> YiM ()
reloadProjectE s :: 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 :: 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 cmd :: Text
cmd args :: [Text]
args onExit :: 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 cmd :: Text
cmd args :: [Text]
args onExit :: 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
$ \r :: 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 command :: Text
command = if Text
command Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["eval","exec","ghci","repl","runghc","runhaskell","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 args :: [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM ()) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun "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 cmd :: Text
cmd onExit :: Either SomeException ExitCode -> YiM x
onExit (CommandArguments args :: [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
runner "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 onExit :: Either SomeException ExitCode -> YiM x
onExit (CommandArguments args :: [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun "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 "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 ["-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 "*.hs")
grepFind :: String ::: FilePatternTag -> String ::: RegexTag -> YiM ()
grepFind :: (String ::: FilePatternTag) -> (String ::: RegexTag) -> YiM ()
grepFind (Doc filePattern :: String
filePattern) (Doc searchedRegex :: 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 "find" [".",
"-name", "_darcs", "-prune", "-o",
"-name", String
filePattern, "-exec", "grep", "-Hnie", String
searchedRegex, "{}", ";"] (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 cmd :: 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 cmd :: Text
cmd onExit :: Either SomeException ExitCode -> YiM x
onExit (CommandArguments args :: [Text]
args) = Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
forall x.
Text
-> [Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
runner "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