-- | This module provides bracketed paste support as described at
--
-- http://cirw.in/blog/bracketed-paste
module Graphics.Vty.Input.Paste
  ( parseBracketedPaste
  , bracketedPasteStarted
  , bracketedPasteFinished
  )
where

import qualified Data.ByteString.Char8 as BS8

import Graphics.Vty.Input.Events
import Graphics.Vty.Input.Classify.Types

import Data.List (isPrefixOf, isInfixOf)

bracketedPasteStart :: String
bracketedPasteStart :: String
bracketedPasteStart = String
"\ESC[200~"

bracketedPasteEnd :: String
bracketedPasteEnd :: String
bracketedPasteEnd = String
"\ESC[201~"

-- | Does the input start a bracketed paste?
bracketedPasteStarted :: String -> Bool
bracketedPasteStarted :: String -> Bool
bracketedPasteStarted = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
bracketedPasteStart

-- | Does the input contain a complete bracketed paste?
bracketedPasteFinished :: String -> Bool
bracketedPasteFinished :: String -> Bool
bracketedPasteFinished = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
bracketedPasteEnd

-- | Parse a bracketed paste. This should only be called on a string if
-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return
-- 'True'.
parseBracketedPaste :: String -> KClass
parseBracketedPaste :: String -> KClass
parseBracketedPaste String
s =
    let (String
p, String
rest) = String -> String -> (String, String)
forall a. Eq a => [a] -> [a] -> ([a], [a])
takeUntil (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bracketedPasteStart) String
s) String
bracketedPasteEnd
        rest' :: String
rest' = if String
bracketedPasteEnd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
rest
                then Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bracketedPasteEnd) String
rest
                else String
rest
    in Event -> String -> KClass
Valid (ByteString -> Event
EvPaste (ByteString -> Event) -> ByteString -> Event
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS8.pack String
p) String
rest'

takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])
takeUntil :: [a] -> [a] -> ([a], [a])
takeUntil [] [a]
_ = ([], [])
takeUntil [a]
cs [a]
sub
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
sub      = ([a]
cs, [])
  | Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
sub) [a]
cs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
sub = ([], Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
sub) [a]
cs)
  | Bool
otherwise                   = let ([a]
pre, [a]
suf) = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
takeUntil ([a] -> [a]
forall a. [a] -> [a]
tail [a]
cs) [a]
sub
                                  in ([a] -> a
forall a. [a] -> a
head [a]
csa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pre, [a]
suf)