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

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.Read
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Keymap.Vim.Ex.Commands.Read (parse) where

import           Control.Applicative              (Alternative ((<|>)))
import           Control.Monad.Base               (liftBase)
import qualified Data.Attoparsec.Text             as P (anyChar, many1, space, string, try)
import           Data.Monoid                      ((<>))
import qualified Data.Text                        as T (Text, pack)
import qualified Data.Text.IO                     as T (readFile)
import           System.Exit                      (ExitCode (..))
import           Yi.Buffer.HighLevel              (insertRopeWithStyleB)
import           Yi.Buffer.Normal                 (RegionStyle (LineWise))
import           Yi.Editor                        (printMsg, withCurrentBuffer)
import           Yi.Keymap                        (Action (YiA), YiM)
import           Yi.Keymap.Vim.Common             (EventString)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdShow))
import           Yi.Process                       (runShellCommand)
import           Yi.Rope                          (fromText, YiString)

parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse = Parser ExCommand -> EventString -> Maybe ExCommand
Common.parse (Parser ExCommand -> EventString -> Maybe ExCommand)
-> Parser ExCommand -> EventString -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$
               (Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text Text
P.string Text
"read") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string Text
"r") Parser Text Text -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.space
            Parser Text [Char] -> Parser ExCommand -> Parser ExCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Text -> Parser Text Text
P.string Text
"!" Parser Text Text -> Parser ExCommand -> Parser ExCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ExCommand
parseCommand) Parser ExCommand -> Parser ExCommand -> Parser ExCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ExCommand
parseReadFile)
    where parseReadFile :: Parser ExCommand
parseReadFile = do
            [Char]
filename <- Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.anyChar
            ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$! Text -> YiM YiString -> ExCommand
readCmd (Text
"read file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
filename)
                              (IO YiString -> YiM YiString
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO YiString -> YiM YiString) -> IO YiString -> YiM YiString
forall a b. (a -> b) -> a -> b
$ Text -> YiString
fromText (Text -> YiString) -> IO Text -> IO YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
filename)
          parseCommand :: Parser ExCommand
parseCommand = do
            [Char]
command <- Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.anyChar
            ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$! Text -> YiM YiString -> ExCommand
readCmd (Text
"read command " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
command) ([Char] -> YiM YiString
runShellCommand' [Char]
command)
          runShellCommand' :: String -> YiM YiString
          runShellCommand' :: [Char] -> YiM YiString
runShellCommand' [Char]
cmd = do
            (ExitCode
exitCode,Text
cmdOut,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))
-> IO (ExitCode, Text, Text) -> YiM (ExitCode, Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (ExitCode, Text, Text)
forall a c. ListLikeProcessIO a c => [Char] -> IO (ExitCode, a, a)
runShellCommand [Char]
cmd
            case ExitCode
exitCode of
              ExitCode
ExitSuccess -> YiString -> YiM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return (YiString -> YiM YiString) -> YiString -> YiM YiString
forall a b. (a -> b) -> a -> b
$ Text -> YiString
fromText Text
cmdOut
              ExitFailure Int
_ -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
cmdErr YiM () -> YiM YiString -> YiM YiString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiString -> YiM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return YiString
""

readCmd :: T.Text -> YiM YiString -> ExCommand
readCmd :: Text -> YiM YiString -> ExCommand
readCmd Text
cmdShowText YiM YiString
getYiString = ExCommand
Common.impureExCommand
  { cmdShow :: Text
cmdShow = Text
cmdShowText
  , cmdAction :: Action
cmdAction = YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (YiM () -> Action) -> YiM () -> Action
forall a b. (a -> b) -> a -> b
$ do
      YiString
s <- YiM YiString
getYiString
      BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ YiString -> RegionStyle -> BufferM ()
insertRopeWithStyleB YiString
s RegionStyle
LineWise
  }