{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE RankNTypes  #-}

module GHCup.Utils.Output where

import Data.Void
import Data.Char
import Control.Applicative

import qualified Data.Text as T
import qualified Text.Megaparsec               as MP
import qualified Text.Megaparsec.Char          as MPC
import qualified System.Console.Terminal.Size  as TP


-- | Checks whether the given text lines fit in the terminal window.
-- Returns 'Nothing' if the terminal size could not be determined (e.g. bc we're
-- part of a pipe).
fitsInTerminal :: [T.Text] -> IO (Maybe Bool)
fitsInTerminal :: [Text] -> IO (Maybe Bool)
fitsInTerminal [Text]
text = (Window Int -> Bool) -> Maybe (Window Int) -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TP.Window Int
h Int
_) -> [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Maybe (Window Int) -> Maybe Bool)
-> IO (Maybe (Window Int)) -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
TP.size

-- | Like 'fitsInTerminal', but takes a single text blob.
fitsInTerminal' :: T.Text -> IO (Maybe Bool)
fitsInTerminal' :: Text -> IO (Maybe Bool)
fitsInTerminal' = [Text] -> IO (Maybe Bool)
fitsInTerminal ([Text] -> IO (Maybe Bool))
-> (Text -> [Text]) -> Text -> IO (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

padTo :: String -> Int -> String
padTo :: [Char] -> Int -> [Char]
padTo [Char]
str Int
x =
  let lstr :: Int
lstr = [Char] -> Int
strWidth [Char]
str
      add' :: Int
add' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lstr
  in  if Int
add' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then [Char]
str else [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
add' Char
' '


-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth :: [Char] -> Int
strWidth =
  [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
    ([Int] -> Int) -> ([Char] -> [Int]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)
    ([Int] -> [Int]) -> ([Char] -> [Int]) -> [Char] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Int -> Int) -> Int -> [Char] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
a Int
b -> Char -> Int
charWidth Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Int
0)
    ([[Char]] -> [Int]) -> ([Char] -> [[Char]]) -> [Char] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
    ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
stripAnsi

-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi :: [Char] -> [Char]
stripAnsi [Char]
s' =
  case
      Parsec Void [Char] [[Char]] -> [Char] -> Maybe [[Char]]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
MP.parseMaybe (ParsecT Void [Char] Identity [Char] -> Parsec Void [Char] [[Char]]
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void [Char] Identity [Char]
 -> Parsec Void [Char] [[Char]])
-> ParsecT Void [Char] Identity [Char]
-> Parsec Void [Char] [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity [Char]
forall a b.
a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a.
ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void [Char] Identity Char
ansi ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
-> ParsecT Void [Char] Identity [Char]
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
MP.anySingle) [Char]
s'
    of
      Maybe [[Char]]
Nothing -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad ansi escape"  -- PARTIAL: should not happen
      Just [[Char]]
xs -> [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
xs
 where
    -- This parses lots of invalid ANSI escape codes, but that should be fine
  ansi :: ParsecT Void [Char] Identity Char
ansi =
    Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string [Char]
Tokens [Char]
"\ESC[" ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity (Tokens [Char])
digitSemicolons ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
suffix ParsecT Void [Char] Identity Char
-> [Char] -> ParsecT Void [Char] Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
MP.<?> [Char]
"ansi" :: MP.Parsec
        Void
        String
        Char
  digitSemicolons :: ParsecT Void [Char] Identity (Tokens [Char])
digitSemicolons = Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token [Char]
c -> Char -> Bool
isDigit Char
Token [Char]
c Bool -> Bool -> Bool
|| Char
Token [Char]
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';')
  suffix :: ParsecT Void [Char] Identity (Token [Char])
suffix = [Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.oneOf [Char
'A', Char
'B', Char
'C', Char
'D', Char
'H', Char
'J', Char
'K', Char
'f', Char
'm', Char
's', Char
'u']

-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth Char
c = case Char
c of
  Char
_ | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x0300'                     -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x036F'   -> Int
0
    |  -- combining
      Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0370' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FC'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x115F'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1160' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11A2'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x11A3' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11A7'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x11A8' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11F9'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x11FA' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11FF'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2328'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2329' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x232A'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x232B' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2E31'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2E80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x303E'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x303F'                    -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3041' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3247'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3248' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x324F'   -> Int
1
    | -- ambiguous
      Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3250' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DBF'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x4DC0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DFF'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x4E00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xA4C6'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xA4D0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xA95F'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xA960' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xA97C'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xA980' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xABF9'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xAC00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD7FB'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xD800' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xDFFF'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xE000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xF8FF'   -> Int
1
    | -- ambiguous
      Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFAFF'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFB00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFDFD'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE0F'   -> Int
1
    | -- ambiguous
      Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE10' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE19'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE20' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE26'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE30' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE6B'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE70' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFEFF'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFF01' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFF60'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFF61' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x16A38'  -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1B000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1B001' -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1D000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F1FF' -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F251' -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F773' -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x20000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3FFFD' -> Int
2
    | Bool
otherwise                        -> Int
1