module Unison.PrettyTerminal where

import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Data.Text.IO qualified as Text
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
  Text -> IO ()
less (Text -> IO ())
-> (Pretty ColorText -> Text) -> Pretty ColorText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> Text
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
  Text -> IO ()
Text.putStrLn (Text -> IO ())
-> (Pretty ColorText -> Text) -> Pretty ColorText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> Text
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
  Text -> IO ()
less (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> Text
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
  Text -> IO ()
Text.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> Text
P.toANSI Width
width Pretty ColorText
p

-- | Returns a `P.Width` in the range 80–100, depending on the terminal width.
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 (Int -> Width
P.Width (Int -> Width) -> (Window Int -> Int) -> Window Int -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 (Int -> Int) -> (Window Int -> Int) -> Window Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window Int -> Int
forall a. Window a -> a
Terminal.width) (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