    {-# 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 mo <- Maybe String -> BufferM Mark
    getMarkB (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "StdOUT")
                        p <- pointAt botB
                        q <- use $ markPointA mo
                        return $ mkRegion p 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
        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 ())
        withEditor interactHistoryStart
        mode' <- lookupMode $ AnyMode interMode
        withCurrentBuffer $ do
            m1 <- getMarkB (Just "StdERR")
            m2 <- getMarkB (Just "StdOUT")
            modifyMarkB m1 (\MarkValue
    v -> MarkValue
    v {markGravity = Backward})
            modifyMarkB m2 (\MarkValue
    v -> MarkValue
    v {markGravity = Backward})
            setAnyMode mode'
        return b

    -- | Send the type command to the process
    feedCommand :: YiM ()
    feedCommand :: YiM ()
    feedCommand = do
      b <- (Editor -> BufferRef) -> YiM BufferRef
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets Editor -> BufferRef
    currentBuffer
      withEditor interactHistoryFinish
      cmd <- withCurrentBuffer $ do
          botB
          newlineB
          me <- getMarkB (Just "StdERR")
          mo <- getMarkB (Just "StdOUT")
          p <- pointB
          q <- use $ markPointA mo
          cmd <- readRegionB $ mkRegion p q
          markPointA me .= p
          markPointA mo .= p
          return $ R.toString cmd
      withEditor interactHistoryStart
      sendToProcess b cmd

    -- | Send command, receive reply
    queryReply :: BufferRef -> String -> YiM R.YiString
    queryReply :: BufferRef -> String -> YiM YiString
    queryReply BufferRef
    buf String
    cmd = do
        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)
        sendToProcess buf (cmd <> "\n")
        io $ threadDelay 50000  -- Hack to let ghci finish writing its output.
        withGivenBuffer buf $ do
          botB
          moveToSol
          leftB -- There is probably a much better way to do this moving around, but it works
          end <- pointB
          result <- readRegionB (mkRegion start end)
          botB
          return result