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

-- |
-- Module      :  Yi.Mode.Interactive
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Collection of 'Mode's for working with Haskell.

module Yi.Mode.Interactive where

import           Control.Concurrent   (threadDelay)
import           Lens.Micro.Platform           (use, (%~), (.=))
import           Data.Monoid          ((<>))
import qualified Data.Text            as T (Text)
import           Yi.Buffer
import           Yi.Core              (sendToProcess, startSubprocess, withSyntax)
import           Yi.Editor
import           Yi.History           (historyFinishGen, historyMoveGen, historyStartGen)
import           Yi.Keymap            (YiM, topKeymapA)
import           Yi.Keymap.Keys       (Key (KEnter, KHome), char, choice, meta, spec, (<||), (?>>!))
import           Yi.Lexer.Alex        (Tok)
import           Yi.Lexer.Compilation (Token)
import qualified Yi.Mode.Compilation  as Compilation (mode)
import           Yi.Mode.Common       (lookupMode)
import           Yi.Monad             (gets)
import qualified Yi.Rope              as R (YiString, fromText, toString, toText)
import qualified Yi.Syntax.OnlineTree as OnlineTree (Tree)
import           Yi.Utils             (io)


mode :: Mode (OnlineTree.Tree (Tok Token))
mode :: Mode (Tree (Tok Token))
mode = Mode (Tree (Tok Token))
Compilation.mode
  { modeApplies = modeNeverApplies,
    modeName = "interactive",
    modeKeymap = topKeymapA %~ (<||)
     (choice
      [spec KHome ?>>! moveToSol,
       spec KEnter ?>>! do
          eof <- withCurrentBuffer atLastLine
          if eof
            then feedCommand
            else withSyntax modeFollow,
       meta (char 'p') ?>>! interactHistoryMove 1,
       meta (char 'n') ?>>! interactHistoryMove (-1)
      ])
  }

interactId :: T.Text
interactId :: Text
interactId = Text
"Interact"

-- | TODO: we're just converting back and forth here, 'historyMoveGen'
-- and friends need to migrate to YiString it seems.
interactHistoryMove :: Int -> EditorM ()
interactHistoryMove :: Int -> EditorM ()
interactHistoryMove Int
delta =
  Text -> Int -> EditorM Text -> EditorM Text
historyMoveGen Text
interactId Int
delta (YiString -> Text
R.toText (YiString -> Text) -> EditorM YiString -> EditorM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
getInput) EditorM Text -> (Text -> EditorM ()) -> EditorM ()
forall a b. EditorM a -> (a -> EditorM b) -> EditorM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> EditorM ()
inp
  where
    inp :: Text -> EditorM ()
inp = BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ())
-> (Text -> BufferM ()) -> Text -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
setInput (YiString -> BufferM ())
-> (Text -> YiString) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YiString
R.fromText

interactHistoryFinish :: EditorM ()
interactHistoryFinish :: EditorM ()
interactHistoryFinish =
  Text -> EditorM Text -> EditorM ()
historyFinishGen Text
interactId (YiString -> Text
R.toText (YiString -> Text) -> EditorM YiString -> EditorM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
getInput)

interactHistoryStart :: EditorM ()
interactHistoryStart :: EditorM ()
interactHistoryStart = Text -> EditorM ()
historyStartGen Text
interactId

getInputRegion :: BufferM Region
getInputRegion :: BufferM Region
getInputRegion = do Mark
mo <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdOUT")
                    Point
p <- BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
pointAt BufferM ()
botB
                    Point
q <- Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> Getting Point FBuffer Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Mark -> Getting Point FBuffer Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
mo
                    Region -> BufferM Region
forall a. a -> BufferM a
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
p Point
q

getInput :: BufferM R.YiString
getInput :: BufferM YiString
getInput = Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getInputRegion

setInput :: R.YiString -> BufferM ()
setInput :: YiString -> BufferM ()
setInput YiString
val = (Region -> YiString -> BufferM ())
-> YiString -> Region -> BufferM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Region -> YiString -> BufferM ()
replaceRegionB YiString
val (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getInputRegion

-- | Open a new buffer for interaction with a process.
spawnProcess :: String -> [String] -> YiM BufferRef
spawnProcess :: String -> [String] -> YiM BufferRef
spawnProcess = Mode (Tree (Tok Token)) -> String -> [String] -> YiM BufferRef
forall syntax. Mode syntax -> String -> [String] -> YiM BufferRef
spawnProcessMode Mode (Tree (Tok Token))
mode

-- | open a new buffer for interaction with a process, using any
-- interactive-derived mode
spawnProcessMode :: Mode syntax -> FilePath -> [String] -> YiM BufferRef
spawnProcessMode :: forall syntax. Mode syntax -> String -> [String] -> YiM BufferRef
spawnProcessMode Mode syntax
interMode String
cmd [String]
args = do
    BufferRef
b <- String
-> [String]
-> (Either SomeException ExitCode -> YiM ())
-> YiM BufferRef
forall x.
String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
startSubprocess String
cmd [String]
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 ())
    EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
interactHistoryStart
    AnyMode
mode' <- AnyMode -> YiM AnyMode
lookupMode (AnyMode -> YiM AnyMode) -> AnyMode -> YiM AnyMode
forall a b. (a -> b) -> a -> b
$ Mode syntax -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode syntax
interMode
    BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
        Mark
m1 <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdERR")
        Mark
m2 <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdOUT")
        Mark -> (MarkValue -> MarkValue) -> BufferM ()
modifyMarkB Mark
m1 (\MarkValue
v -> MarkValue
v {markGravity = Backward})
        Mark -> (MarkValue -> MarkValue) -> BufferM ()
modifyMarkB Mark
m2 (\MarkValue
v -> MarkValue
v {markGravity = Backward})
        AnyMode -> BufferM ()
setAnyMode AnyMode
mode'
    BufferRef -> YiM BufferRef
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b



-- | Send the type command to the process
feedCommand :: YiM ()
feedCommand :: YiM ()
feedCommand = do
  BufferRef
b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
  EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
interactHistoryFinish
  String
cmd <- BufferM String -> YiM String
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM String -> YiM String) -> BufferM String -> YiM String
forall a b. (a -> b) -> a -> b
$ do
      BufferM ()
botB
      BufferM ()
newlineB
      Mark
me <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdERR")
      Mark
mo <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdOUT")
      Point
p <- BufferM Point
pointB
      Point
q <- Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> Getting Point FBuffer Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Mark -> Getting Point FBuffer Point
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
mo
      YiString
cmd <- Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> Region -> BufferM YiString
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Region
mkRegion Point
p Point
q
      Mark -> (Point -> Identity Point) -> FBuffer -> Identity FBuffer
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
me ((Point -> Identity Point) -> FBuffer -> Identity FBuffer)
-> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
p
      Mark -> (Point -> Identity Point) -> FBuffer -> Identity FBuffer
forall (f :: * -> *).
Functor f =>
Mark -> (Point -> f Point) -> FBuffer -> f FBuffer
markPointA Mark
mo ((Point -> Identity Point) -> FBuffer -> Identity FBuffer)
-> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
p
      String -> BufferM String
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> BufferM String) -> String -> BufferM String
forall a b. (a -> b) -> a -> b
$ YiString -> String
R.toString YiString
cmd
  EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
interactHistoryStart
  BufferRef -> String -> YiM ()
sendToProcess BufferRef
b String
cmd

-- | Send command, receive reply
queryReply :: BufferRef -> String -> YiM R.YiString
queryReply :: BufferRef -> String -> YiM YiString
queryReply BufferRef
buf String
cmd = do
    Point
start <- BufferRef -> BufferM Point -> YiM Point
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
buf (BufferM ()
botB BufferM () -> BufferM Point -> BufferM Point
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB)
    BufferRef -> String -> YiM ()
sendToProcess BufferRef
buf (String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
    IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
50000  -- Hack to let ghci finish writing its output.
    BufferRef -> BufferM YiString -> YiM YiString
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
buf (BufferM YiString -> YiM YiString)
-> BufferM YiString -> YiM YiString
forall a b. (a -> b) -> a -> b
$ do
      BufferM ()
botB
      BufferM ()
moveToSol
      BufferM ()
leftB -- There is probably a much better way to do this moving around, but it works
      Point
end <- BufferM Point
pointB
      YiString
result <- Region -> BufferM YiString
readRegionB (Point -> Point -> Region
mkRegion Point
start Point
end)
      BufferM ()
botB
      YiString -> BufferM YiString
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return YiString
result