{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Esc -> Esc -> Bool
$c/= :: Esc -> Esc -> Bool
== :: Esc -> Esc -> Bool
$c== :: Esc -> Esc -> Bool
Eq,Int -> Esc -> ShowS
[Esc] -> ShowS
Esc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Esc] -> ShowS
$cshowList :: [Esc] -> ShowS
show :: Esc -> String
$cshow :: Esc -> String
showsPrec :: Int -> Esc -> ShowS
$cshowsPrec :: Int -> Esc -> ShowS
Show)

app :: Esc -> Esc -> Esc
app (Esc String
x) (Esc String
y) = String -> Esc
Esc forall a b. (a -> b) -> a -> b
$ String
x 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) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'm') String
xs = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Esc
Esc forall a b. (a -> b) -> a -> b
$ Char
'\ESC'forall a. a -> [a] -> [a]
:String
preforall a. [a] -> [a] -> [a]
++String
"m", String -> Esc
Esc String
post)
unesc (Esc (Char
x:String
xs)) = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right Char
x, String -> Esc
Esc String
xs)
unesc (Esc []) = forall a. Maybe a
Nothing

explode :: Esc -> [Either Esc Char]
explode :: Esc -> [Either Esc Char]
explode = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Esc -> String
fromEsc forall (f :: * -> *) a. Applicative f => a -> f a
pure)

unescape :: String -> String
unescape :: ShowS
unescape = Esc -> String
unescapeE 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 = forall a b. [Either a b] -> [b]
rights 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 = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Esc -> Maybe Esc
stripPrefixE (Char
xforall a. a -> [a] -> [a]
:String
xs) Esc
rest
    Just (Right Char
y, Esc
rest) | Char
y forall a. Eq a => a -> a -> Bool
== Char
x -> String -> Esc -> Maybe Esc
stripPrefixE String
xs Esc
rest
    Maybe (Either Esc Char, 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 = 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 -> forall a. Maybe a
Nothing
    Just (Either Esc Char
x,Esc
xs) -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app forall a b. (a -> b) -> a -> b
$ forall a. Either a a -> a
fromEither forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Esc
Esc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) Either Esc Char
x) 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 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) -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app Esc
e) 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 -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app forall a b. (a -> b) -> a -> b
$ String -> Esc
Esc [Char
c]) 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 = forall a. Maybe a -> Bool
isJust 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. a -> [a] -> [a]
: 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 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) -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app Esc
code) forall a b. (a -> b) -> a -> b
$ Int -> Esc -> (Esc, Esc)
splitAtE Int
i Esc
rest
    Just (Right Char
c, Esc
rest) -> forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Esc -> Esc -> Esc
app forall a b. (a -> b) -> a -> b
$ String -> Esc
Esc [Char
c]) forall a b. (a -> b) -> a -> b
$ Int -> Esc -> (Esc, Esc)
splitAtE (Int
iforall a. Num a => a -> a -> a
-Int
1) Esc
rest

reverseE :: Esc -> Esc
reverseE :: Esc -> Esc
reverseE = [Either Esc Char] -> Esc
implode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse 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 = forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> (a, a) -> (b, b)
both Esc -> Esc
reverseE forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Esc -> (Esc, Esc)
breakE Char -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Esc -> Esc
reverseE


lengthE :: Esc -> Int
lengthE :: Esc -> Int
lengthE = forall (t :: * -> *) a. Foldable t => t a -> Int
length 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordWrap -> WordWrap -> Bool
$c/= :: WordWrap -> WordWrap -> Bool
== :: WordWrap -> WordWrap -> Bool
$c== :: WordWrap -> WordWrap -> Bool
Eq,Int -> WordWrap -> ShowS
[WordWrap] -> ShowS
WordWrap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordWrap] -> ShowS
$cshowList :: [WordWrap] -> ShowS
show :: WordWrap -> String
$cshow :: WordWrap -> String
showsPrec :: Int -> WordWrap -> ShowS
$cshowsPrec :: Int -> 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 = 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 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 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)