{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeOperators              #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Command
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Various high-level functions to further classify.

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)


---------------------------
-- | Changing the buffer name quite useful if you have
-- several the same. This also breaks the relation with the file.

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
Lens' FBuffer BufferId
identA (BufferId -> BufferM ())
-> (Text -> BufferId) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BufferId
MemBuffer

----------------------------
-- | shell-command with argument prompt
shellCommandE :: YiM ()
shellCommandE :: YiM ()
shellCommandE = Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"Shell command:" Text -> YiM ()
shellCommandV

----------------------------
-- | shell-command with a known argument
shellCommandV :: T.Text -> YiM ()
shellCommandV :: Text -> YiM ()
shellCommandV Text
cmd = do
  (exitCode,cmdOut,cmdErr) <- IO (ExitCode, Text, Text) -> YiM (ExitCode, Text, Text)
forall α. IO α -> YiM α
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 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 a. EditorM a -> YiM a
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
$ -- see GitHub issue #477
                          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)"
                     -- Drop trailing newline from output
                     Text
xs -> if HasCallStack => Text -> Char
Text -> Char
T.last Text
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then HasCallStack => Text -> Text
Text -> Text
T.init Text
xs else Text
xs
    ExitFailure Int
_ -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
cmdErr

----------------------------
-- Cabal-related commands
newtype CabalBuffer = CabalBuffer {CabalBuffer -> Maybe BufferRef
cabalBuffer :: Maybe BufferRef}
    deriving (CabalBuffer
CabalBuffer -> Default CabalBuffer
forall a. a -> Default a
$cdef :: CabalBuffer
def :: 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
$cput :: CabalBuffer -> Put
put :: CabalBuffer -> Put
$cget :: Get CabalBuffer
get :: Get CabalBuffer
$cputList :: [CabalBuffer] -> Put
putList :: [CabalBuffer] -> Put
Binary)

instance YiVariable CabalBuffer

----------------------------
-- | cabal-configure
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 a. a -> YiM a
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

-- | Run the given commands with args and pipe the output into the build buffer,
-- which is shown in an other window.
buildRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
buildRun :: forall x.
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
   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
   maybeM deleteBuffer =<< cabalBuffer <$> getEditorDyn
   putEditorDyn $ CabalBuffer $ Just b
   withCurrentBuffer $ setMode Compilation.mode
   return ()

-- | Run the given command with args in interactive mode.
interactiveRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
interactiveRun :: forall x.
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
    bc <- IO (MVar BufferRef) -> YiM (MVar BufferRef)
forall α. IO α -> YiM α
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
    b <- startSubprocess (T.unpack cmd) (T.unpack <$> args) $ \Either SomeException ExitCode
r -> do
      b <- IO BufferRef -> YiM BufferRef
forall α. IO α -> YiM α
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
      withGivenBuffer b $ setMode Compilation.mode
      onExit r
    maybeM deleteBuffer =<< cabalBuffer <$> getEditorDyn
    withCurrentBuffer $ setMode Interactive.mode
    liftBase $ putMVar bc b
    return ()

-- | Select 'buildRun' or 'interactiveRun' based on stack or cabal command name
selectRunner :: T.Text -> T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
selectRunner :: forall x.
Text
-> Text
-> [Text]
-> (Either SomeException ExitCode -> YiM x)
-> YiM ()
selectRunner Text
command = if Text
command Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> 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 a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

cabalRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
cabalRun :: forall x.
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 :: forall x.
(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

-----------------------
-- | cabal-build
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 a. a -> YiM a
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 a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

shell :: YiM BufferRef
shell :: YiM BufferRef
shell = do
    sh <- IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
shellFileName
    Interactive.spawnProcess sh ["-i"]
    -- use the -i option for interactive mode (assuming bash)

-- | Search the source files in the project.
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")

-- | Perform a find+grep operation
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 a. a -> YiM a
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 a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-----------------------
-- | stack-build

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 a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

stackRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
stackRun :: forall x.
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