{-# LANGUAGE PatternGuards #-}

-- | Module for dealing with escape codes
module Language.Haskell.Ghcid.Escape(
    WordWrap(..),
    Esc(..), unescape,
    stripInfixE, stripPrefixE, isPrefixOfE, spanE, trimStartE, unwordsE, unescapeE,
    wordWrapE
    ) where

import Data.Char
import Data.Either.Extra
import Data.List.Extra
import Data.Maybe
import Data.Tuple.Extra
import Control.Applicative
import Prelude


-- A string with escape characters in it
newtype Esc = Esc {Esc -> String
fromEsc :: String}
    deriving (Esc -> Esc -> Bool
(Esc -> Esc -> Bool) -> (Esc -> Esc -> Bool) -> Eq Esc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Esc -> Esc -> Bool
== :: Esc -> Esc -> Bool
$c/= :: Esc -> Esc -> Bool
/= :: Esc -> Esc -> Bool
Eq,Int -> Esc -> ShowS
[Esc] -> ShowS
Esc -> String
(Int -> Esc -> ShowS)
-> (Esc -> String) -> ([Esc] -> ShowS) -> Show Esc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Esc -> ShowS
showsPrec :: Int -> Esc -> ShowS
$cshow :: Esc -> String
show :: Esc -> String
$cshowList :: [Esc] -> ShowS
showList :: [Esc] -> ShowS
Show)

app :: Esc -> Esc -> Esc
app (Esc String
x) (Esc String
y) = String -> Esc
Esc (String -> Esc) -> String -> Esc
forall a b. (a -> b) -> a -> b
$ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y

unesc :: Esc -> Maybe (Either Esc Char, Esc)
unesc :: Esc -> Maybe (Either Esc Char, Esc)
unesc (Esc (Char
'\ESC':String
xs)) | (String
pre,Char
'm':String
post) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'm') String
xs = (Either Esc Char, Esc) -> Maybe (Either Esc Char, Esc)
forall a. a -> Maybe a
Just (Esc -> Either Esc Char
forall a b. a -> Either a b
Left (Esc -> Either Esc Char) -> Esc -> Either Esc Char
forall a b. (a -> b) -> a -> b
$ String -> Esc
Esc (String -> Esc) -> String -> Esc
forall a b. (a -> b) -> a -> b
$ Char
'\ESC'Char -> ShowS
forall a. a -> [a] -> [a]
:String
preString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"m", String -> Esc
Esc String
post)
unesc (Esc (Char
x:String
xs)) = (Either Esc Char, Esc) -> Maybe (Either Esc Char, Esc)
forall a. a -> Maybe a
Just (Char -> Either Esc Char
forall a b. b -> Either a b
Right Char
x, String -> Esc
Esc String
xs)
unesc (Esc []) = Maybe (Either Esc Char, Esc)
forall a. Maybe a
Nothing

explode :: Esc -> [Either Esc Char]
explode :: Esc -> [Either Esc Char]
explode = (Esc -> Maybe (Either Esc Char, Esc)) -> Esc -> [Either Esc Char]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Esc -> Maybe (Either Esc Char, Esc)
unesc

implode :: [Either Esc Char] -> Esc
implode :: [Either Esc Char] -> Esc
implode = String -> Esc
Esc (String -> Esc)
-> ([Either Esc Char] -> String) -> [Either Esc Char] -> Esc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Esc Char -> String) -> [Either Esc Char] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Esc -> String) -> (Char -> String) -> Either Esc Char -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Esc -> String
fromEsc Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

unescape :: String -> String
unescape :: ShowS
unescape = Esc -> String
unescapeE (Esc -> String) -> (String -> Esc) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Esc
Esc

-- | Remove all escape characters in a string
unescapeE :: Esc -> String
unescapeE :: Esc -> String
unescapeE = [Either Esc Char] -> String
forall a b. [Either a b] -> [b]
rights ([Either Esc Char] -> String)
-> (Esc -> [Either Esc Char]) -> Esc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> [Either Esc Char]
explode

stripPrefixE :: String -> Esc -> Maybe Esc
stripPrefixE :: String -> Esc -> Maybe Esc
stripPrefixE [] Esc
e = Esc -> Maybe Esc
forall a. a -> Maybe a
Just Esc
e
stripPrefixE (Char
x:String
xs) Esc
e = case Esc -> Maybe (Either Esc Char, Esc)
unesc Esc
e of
    Just (Left Esc
code, Esc
rest) -> Esc -> Esc -> Esc
app Esc
code (Esc -> Esc) -> Maybe Esc -> Maybe Esc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Esc -> Maybe Esc
stripPrefixE (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) Esc
rest
    Just (Right Char
y, Esc
rest) | Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x -> String -> Esc -> Maybe Esc
stripPrefixE String
xs Esc
rest
    Maybe (Either Esc Char, Esc)
_ -> Maybe Esc
forall a. Maybe a
Nothing

stripInfixE :: String -> Esc -> Maybe (Esc, Esc)
stripInfixE :: String -> Esc -> Maybe (Esc, Esc)
stripInfixE String
needle Esc
haystack | Just Esc
rest <- String -> Esc -> Maybe Esc
stripPrefixE String
needle Esc
haystack = (Esc, Esc) -> Maybe (Esc, Esc)
forall a. a -> Maybe a
Just (String -> Esc
Esc [], Esc
rest)
stripInfixE String
needle Esc
e = case Esc -> Maybe (Either Esc Char, Esc)
unesc Esc
e of
    Maybe (Either Esc Char, Esc)
Nothing -> Maybe (Esc, Esc)
forall a. Maybe a
Nothing
    Just (Either Esc Char
x,Esc
xs) -> (Esc -> Esc) -> (Esc, Esc) -> (Esc, Esc)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app (Esc -> Esc -> Esc) -> Esc -> Esc -> Esc
forall a b. (a -> b) -> a -> b
$ Either Esc Esc -> Esc
forall a. Either a a -> a
fromEither (Either Esc Esc -> Esc) -> Either Esc Esc -> Esc
forall a b. (a -> b) -> a -> b
$ (Char -> Esc) -> Either Esc Char -> Either Esc Esc
forall a b. (a -> b) -> Either Esc a -> Either Esc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Esc
Esc (String -> Esc) -> (Char -> String) -> Char -> Esc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Either Esc Char
x) ((Esc, Esc) -> (Esc, Esc)) -> Maybe (Esc, Esc) -> Maybe (Esc, Esc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Esc -> Maybe (Esc, Esc)
stripInfixE String
needle Esc
xs


spanE, breakE :: (Char -> Bool) -> Esc -> (Esc, Esc)
breakE :: (Char -> Bool) -> Esc -> (Esc, Esc)
breakE Char -> Bool
f = (Char -> Bool) -> Esc -> (Esc, Esc)
spanE (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)
spanE :: (Char -> Bool) -> Esc -> (Esc, Esc)
spanE Char -> Bool
f Esc
e = case Esc -> Maybe (Either Esc Char, Esc)
unesc Esc
e of
    Maybe (Either Esc Char, Esc)
Nothing -> (String -> Esc
Esc String
"", String -> Esc
Esc String
"")
    Just (Left Esc
e, Esc
rest) -> (Esc -> Esc) -> (Esc, Esc) -> (Esc, Esc)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app Esc
e) ((Esc, Esc) -> (Esc, Esc)) -> (Esc, Esc) -> (Esc, Esc)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Esc -> (Esc, Esc)
spanE Char -> Bool
f Esc
rest
    Just (Right Char
c, Esc
rest) | Char -> Bool
f Char
c -> (Esc -> Esc) -> (Esc, Esc) -> (Esc, Esc)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app (Esc -> Esc -> Esc) -> Esc -> Esc -> Esc
forall a b. (a -> b) -> a -> b
$ String -> Esc
Esc [Char
c]) ((Esc, Esc) -> (Esc, Esc)) -> (Esc, Esc) -> (Esc, Esc)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Esc -> (Esc, Esc)
spanE Char -> Bool
f Esc
rest
                         | Bool
otherwise -> (String -> Esc
Esc String
"", Esc
e)

isPrefixOfE :: String -> Esc -> Bool
isPrefixOfE :: String -> Esc -> Bool
isPrefixOfE String
x Esc
y = Maybe Esc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Esc -> Bool) -> Maybe Esc -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Esc -> Maybe Esc
stripPrefixE String
x Esc
y

trimStartE :: Esc -> Esc
trimStartE :: Esc -> Esc
trimStartE Esc
e = case Esc -> Maybe (Either Esc Char, Esc)
unesc Esc
e of
    Maybe (Either Esc Char, Esc)
Nothing -> String -> Esc
Esc String
""
    Just (Left Esc
code, Esc
rest) -> Esc -> Esc -> Esc
app Esc
code (Esc -> Esc) -> Esc -> Esc
forall a b. (a -> b) -> a -> b
$ Esc -> Esc
trimStartE Esc
rest
    Just (Right Char
c, Esc
rest) | Char -> Bool
isSpace Char
c -> Esc -> Esc
trimStartE Esc
rest
                         | Bool
otherwise -> Esc
e

unwordsE :: [Esc] -> Esc
unwordsE :: [Esc] -> Esc
unwordsE = String -> Esc
Esc (String -> Esc) -> ([Esc] -> String) -> [Esc] -> Esc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> ([Esc] -> [String]) -> [Esc] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Esc -> String) -> [Esc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Esc -> String
fromEsc


repeatedlyE :: (Esc -> (b, Esc)) -> Esc -> [b]
repeatedlyE :: forall b. (Esc -> (b, Esc)) -> Esc -> [b]
repeatedlyE Esc -> (b, Esc)
f (Esc []) = []
repeatedlyE Esc -> (b, Esc)
f Esc
as = b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (Esc -> (b, Esc)) -> Esc -> [b]
forall b. (Esc -> (b, Esc)) -> Esc -> [b]
repeatedlyE Esc -> (b, Esc)
f Esc
as'
    where (b
b, Esc
as') = Esc -> (b, Esc)
f Esc
as

splitAtE :: Int -> Esc -> (Esc, Esc)
splitAtE :: Int -> Esc -> (Esc, Esc)
splitAtE Int
i Esc
e = case Esc -> Maybe (Either Esc Char, Esc)
unesc Esc
e of
    Maybe (Either Esc Char, Esc)
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> (String -> Esc
Esc String
"", Esc
e)
    Maybe (Either Esc Char, Esc)
Nothing -> (Esc
e, Esc
e)
    Just (Left Esc
code, Esc
rest) -> (Esc -> Esc) -> (Esc, Esc) -> (Esc, Esc)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app Esc
code) ((Esc, Esc) -> (Esc, Esc)) -> (Esc, Esc) -> (Esc, Esc)
forall a b. (a -> b) -> a -> b
$ Int -> Esc -> (Esc, Esc)
splitAtE Int
i Esc
rest
    Just (Right Char
c, Esc
rest) -> (Esc -> Esc) -> (Esc, Esc) -> (Esc, Esc)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app (Esc -> Esc -> Esc) -> Esc -> Esc -> Esc
forall a b. (a -> b) -> a -> b
$ String -> Esc
Esc [Char
c]) ((Esc, Esc) -> (Esc, Esc)) -> (Esc, Esc) -> (Esc, Esc)
forall a b. (a -> b) -> a -> b
$ Int -> Esc -> (Esc, Esc)
splitAtE (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Esc
rest

reverseE :: Esc -> Esc
reverseE :: Esc -> Esc
reverseE = [Either Esc Char] -> Esc
implode ([Either Esc Char] -> Esc)
-> (Esc -> [Either Esc Char]) -> Esc -> Esc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Esc Char] -> [Either Esc Char]
forall a. [a] -> [a]
reverse ([Either Esc Char] -> [Either Esc Char])
-> (Esc -> [Either Esc Char]) -> Esc -> [Either Esc Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> [Either Esc Char]
explode

breakEndE :: (Char -> Bool) -> Esc -> (Esc, Esc)
breakEndE :: (Char -> Bool) -> Esc -> (Esc, Esc)
breakEndE Char -> Bool
f = (Esc, Esc) -> (Esc, Esc)
forall a b. (a, b) -> (b, a)
swap ((Esc, Esc) -> (Esc, Esc))
-> (Esc -> (Esc, Esc)) -> Esc -> (Esc, Esc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Esc -> Esc) -> (Esc, Esc) -> (Esc, Esc)
forall a b. (a -> b) -> (a, a) -> (b, b)
both Esc -> Esc
reverseE ((Esc, Esc) -> (Esc, Esc))
-> (Esc -> (Esc, Esc)) -> Esc -> (Esc, Esc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Esc -> (Esc, Esc)
breakE Char -> Bool
f (Esc -> (Esc, Esc)) -> (Esc -> Esc) -> Esc -> (Esc, Esc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> Esc
reverseE


lengthE :: Esc -> Int
lengthE :: Esc -> Int
lengthE = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (Esc -> String) -> Esc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> String
unescapeE


-- | 'WrapHard' means you have to
data WordWrap = WrapHard | WrapSoft
    deriving (WordWrap -> WordWrap -> Bool
(WordWrap -> WordWrap -> Bool)
-> (WordWrap -> WordWrap -> Bool) -> Eq WordWrap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WordWrap -> WordWrap -> Bool
== :: WordWrap -> WordWrap -> Bool
$c/= :: WordWrap -> WordWrap -> Bool
/= :: WordWrap -> WordWrap -> Bool
Eq,Int -> WordWrap -> ShowS
[WordWrap] -> ShowS
WordWrap -> String
(Int -> WordWrap -> ShowS)
-> (WordWrap -> String) -> ([WordWrap] -> ShowS) -> Show WordWrap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WordWrap -> ShowS
showsPrec :: Int -> WordWrap -> ShowS
$cshow :: WordWrap -> String
show :: WordWrap -> String
$cshowList :: [WordWrap] -> ShowS
showList :: [WordWrap] -> ShowS
Show)


-- | Word wrap a string into N separate strings.
--   Flows onto a subsequent line if less than N characters end up being empty.
wordWrapE :: Int -> Int -> Esc -> [(Esc, WordWrap)]
wordWrapE :: Int -> Int -> Esc -> [(Esc, WordWrap)]
wordWrapE Int
mx Int
gap = (Esc -> ((Esc, WordWrap), Esc)) -> Esc -> [(Esc, WordWrap)]
forall b. (Esc -> (b, Esc)) -> Esc -> [b]
repeatedlyE Esc -> ((Esc, WordWrap), Esc)
f
    where
        f :: Esc -> ((Esc, WordWrap), Esc)
f Esc
x =
            let (Esc
a,Esc
b) = Int -> Esc -> (Esc, Esc)
splitAtE Int
mx Esc
x in
            if Esc
b Esc -> Esc -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Esc
Esc String
"" then ((Esc
a, WordWrap
WrapHard), String -> Esc
Esc String
"") else
                let (Esc
a1,Esc
a2) = (Char -> Bool) -> Esc -> (Esc, Esc)
breakEndE Char -> Bool
isSpace Esc
a in
                if Esc -> Int
lengthE Esc
a2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
gap then ((Esc
a1, WordWrap
WrapHard), Esc -> Esc -> Esc
app Esc
a2 Esc
b) else ((Esc
a, WordWrap
WrapSoft), Esc -> Esc
trimStartE Esc
b)