module Unison.PrettyTerminal where

import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import System.Console.Terminal.Size qualified as Terminal
import Unison.Util.ColorText qualified as CT
import Unison.Util.Less (less)
import Unison.Util.Pretty qualified as P

stripSurroundingBlanks :: String -> String
stripSurroundingBlanks :: String -> String
stripSurroundingBlanks String
s = [String] -> String
unlines ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall {t :: * -> *}. Foldable t => t Char -> Bool
isBlank ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd String -> Bool
forall {t :: * -> *}. Foldable t => t Char -> Bool
isBlank ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s)
  where
    isBlank :: t Char -> Bool
isBlank t Char
line = (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace t Char
line

-- like putPrettyLn' but prints a blank line before and after.
putPrettyLn :: P.Pretty CT.ColorText -> IO ()
putPrettyLn :: Pretty ColorText -> IO ()
putPrettyLn Pretty ColorText
p | Pretty ColorText
p Pretty ColorText -> Pretty ColorText -> Bool
forall a. Eq a => a -> a -> Bool
== Pretty ColorText
forall a. Monoid a => a
mempty = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
putPrettyLn Pretty ColorText
p = do
  Width
width <- IO Width
getAvailableWidth
  String -> IO ()
less (String -> IO ())
-> (Pretty ColorText -> String) -> Pretty ColorText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> String
P.toANSI Width
width (Pretty ColorText -> IO ()) -> Pretty ColorText -> IO ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.border Width
2 Pretty ColorText
p

putPrettyLnUnpaged :: P.Pretty CT.ColorText -> IO ()
putPrettyLnUnpaged :: Pretty ColorText -> IO ()
putPrettyLnUnpaged Pretty ColorText
p | Pretty ColorText
p Pretty ColorText -> Pretty ColorText -> Bool
forall a. Eq a => a -> a -> Bool
== Pretty ColorText
forall a. Monoid a => a
mempty = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
putPrettyLnUnpaged Pretty ColorText
p = do
  Width
width <- IO Width
getAvailableWidth
  String -> IO ()
putStrLn (String -> IO ())
-> (Pretty ColorText -> String) -> Pretty ColorText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> String
P.toANSI Width
width (Pretty ColorText -> IO ()) -> Pretty ColorText -> IO ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.border Width
2 Pretty ColorText
p

putPrettyLn' :: P.Pretty CT.ColorText -> IO ()
putPrettyLn' :: Pretty ColorText -> IO ()
putPrettyLn' Pretty ColorText
p | Pretty ColorText
p Pretty ColorText -> Pretty ColorText -> Bool
forall a. Eq a => a -> a -> Bool
== Pretty ColorText
forall a. Monoid a => a
mempty = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
putPrettyLn' Pretty ColorText
p = do
  Width
width <- IO Width
getAvailableWidth
  String -> IO ()
less (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> String
P.toANSI Width
width Pretty ColorText
p

clearCurrentLine :: IO ()
clearCurrentLine :: IO ()
clearCurrentLine = do
  Width
width <- IO Width
getAvailableWidth
  String -> IO ()
putStr String
"\r"
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Width -> Int
P.widthToInt Width
width) Char
' '
  String -> IO ()
putStr String
"\r"

putPretty' :: P.Pretty CT.ColorText -> IO ()
putPretty' :: Pretty ColorText -> IO ()
putPretty' Pretty ColorText
p = do
  Width
width <- IO Width
getAvailableWidth
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> String
P.toANSI Width
width Pretty ColorText
p

getAvailableWidth :: IO P.Width
getAvailableWidth :: IO Width
getAvailableWidth =
  Width -> (Window Int -> Width) -> Maybe (Window Int) -> Width
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Width
80 (\Window Int
s -> Width
100 Width -> Width -> Width
forall a. Ord a => a -> a -> a
`min` Int -> Width
P.Width (Window Int -> Int
forall a. Window a -> a
Terminal.width Window Int
s)) (Maybe (Window Int) -> Width)
-> IO (Maybe (Window Int)) -> IO Width
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
Terminal.size

putPrettyNonempty :: P.Pretty P.ColorText -> IO ()
putPrettyNonempty :: Pretty ColorText -> IO ()
putPrettyNonempty Pretty ColorText
msg = do
  if Pretty ColorText
msg Pretty ColorText -> Pretty ColorText -> Bool
forall a. Eq a => a -> a -> Bool
== Pretty ColorText
forall a. Monoid a => a
mempty then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else Pretty ColorText -> IO ()
putPrettyLn Pretty ColorText
msg