module Yi.Command where
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 (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 = withMinibufferFree "New buffer name:" strFun
where
strFun :: T.Text -> YiM ()
strFun = withCurrentBuffer . (.=) identA . MemBuffer
shellCommandE :: YiM ()
shellCommandE = withMinibufferFree "Shell command:" shellCommandV
shellCommandV :: T.Text -> YiM ()
shellCommandV cmd = do
(exitCode,cmdOut,cmdErr) <- liftBase . runShellCommand $ T.unpack cmd
case exitCode of
ExitSuccess -> if T.length (T.filter (== '\n') cmdOut) > 17
then withEditor . void $
newBufferE (MemBuffer "Shell Command Output")
(R.fromText cmdOut)
else printMsg $ case cmdOut of
"" -> "(Shell command with no output)"
xs -> if T.last xs == '\n' then T.init xs else xs
ExitFailure _ -> printMsg cmdErr
newtype CabalBuffer = CabalBuffer {cabalBuffer :: Maybe BufferRef}
deriving (Default, Typeable, Binary)
instance YiVariable CabalBuffer
cabalConfigureE :: CommandArguments -> YiM ()
cabalConfigureE = cabalRun "configure" configureExit
configureExit :: Either SomeException ExitCode -> YiM ()
configureExit (Right ExitSuccess) = reloadProjectE "."
configureExit _ = return ()
reloadProjectE :: String -> YiM ()
reloadProjectE s = withUI $ \ui -> reloadProject ui s
buildRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun cmd args onExit = withOtherWindow $ do
b <- startSubprocess (T.unpack cmd) (T.unpack <$> args) onExit
maybeM deleteBuffer =<< cabalBuffer <$> getEditorDyn
putEditorDyn $ CabalBuffer $ Just b
withCurrentBuffer $ setMode Compilation.mode
return ()
makeBuild :: CommandArguments -> YiM ()
makeBuild (CommandArguments args) = buildRun "make" args (const $ return ())
cabalRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
cabalRun cmd onExit (CommandArguments args) = buildRun "cabal" (cmd:args) onExit
makeRun :: (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
makeRun onExit (CommandArguments args) = buildRun "make" args onExit
cabalBuildE :: CommandArguments -> YiM ()
cabalBuildE = cabalRun "build" (const $ return ())
makeBuildE :: CommandArguments -> YiM ()
makeBuildE = makeRun (const $ return ())
shell :: YiM BufferRef
shell = do
sh <- io shellFileName
Interactive.spawnProcess sh ["-i"]
searchSources :: String ::: RegexTag -> YiM ()
searchSources = grepFind (Doc "*.hs")
grepFind :: String ::: FilePatternTag -> String ::: RegexTag -> YiM ()
grepFind (Doc filePattern) (Doc searchedRegex) = withOtherWindow $ do
void $ startSubprocess "find" [".",
"-name", "_darcs", "-prune", "-o",
"-name", filePattern, "-exec", "grep", "-Hnie", searchedRegex, "{}", ";"] (const $ return ())
withCurrentBuffer $ setMode Compilation.mode
return ()
stackCommandE :: T.Text -> CommandArguments -> YiM ()
stackCommandE cmd = stackRun cmd (const $ return ())
stackRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
stackRun cmd onExit (CommandArguments args) = buildRun "stack" (cmd:args) onExit