git.iko.soy/obelisk
on decrease-android-validity help sign in
obelisk/lib/cliapp/src/Obelisk/CliApp/TerminalString.hs
84 lines 2.7 kB history raw
1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE OverloadedStrings #-}
4-- | Types and functions dealing with strings to be printed on terminal.
5module Obelisk.CliApp.TerminalString
6 ( TerminalString(..)
7 , render
8 , putStrWithSGR
9 , getTerminalWidth
10 , enquiryCode
11 ) where
13import Control.Monad (when)
14import Control.Monad.Catch (bracket_)
15import Control.Monad.IO.Class (liftIO)
16import Control.Monad.Reader (MonadIO)
17import Data.Semigroup ((<>))
18import Data.Text (Text)
19import qualified Data.Text as T
20import qualified Data.Text.IO as T
21import System.Console.ANSI
22import qualified System.Console.Terminal.Size as TerminalSize
23import System.IO (Handle)
25-- | Printable text on terminals
26--
27-- Represents text with an optional color code.
28data TerminalString
29 = TerminalString_Normal Text
30 | TerminalString_Colorized Color Text
31 deriving (Eq, Show, Ord)
33printableLength :: [TerminalString] -> Int
34printableLength = T.length . toText False
36-- Render a list of TerminalString as Text that can be directly putStr'ed.
37render
38 :: Bool -- ^ with color
39 -> Maybe Int -- ^ optionally, trim to maximum width
40 -> [TerminalString]
41 -> Text
42render withColor w ts = trim w $ toText withColor ts
43 where
44 trim = \case
45 Nothing -> id
46 Just n -> \s -> if printableLength ts > n
47 then T.take (n-3) s <> "..." <> T.pack resetCode
48 else s
50toText :: Bool -> [TerminalString] -> Text
51toText withColor = mconcat . map (toText' withColor)
53-- | Convert to Text, controlling whether colorization should happen.
54toText' :: Bool -> TerminalString -> Text
55toText' withColor = \case
56 TerminalString_Normal s -> s
57 TerminalString_Colorized c s -> if withColor then colorizeText c s else s
59-- | Colorize the given text so that it is printed in color when using putStr.
60colorizeText :: Color -> Text -> Text
61colorizeText color s = mconcat
62 [ T.pack $ setSGRCode [SetColor Foreground Vivid color]
63 , s
64 , T.pack resetCode
65 ]
67-- | Safely print the string with the given ANSI control codes, resetting in the end.
68putStrWithSGR :: MonadIO m => [SGR] -> Handle -> Bool -> Text -> m ()
69putStrWithSGR sgr h withNewLine s = liftIO $ bracket_ (hSetSGR h sgr) reset $ T.hPutStr h s
70 where
71 reset = hSetSGR h [Reset] >> newline -- New line should come *after* reset (to reset cursor color).
72 newline = when withNewLine $ T.hPutStrLn h ""
74-- | Code for https://en.wikipedia.org/wiki/Enquiry_character
75enquiryCode :: String
76enquiryCode = "\ENQ"
78-- | Code to reset ANSI colors
79resetCode :: String
80resetCode = setSGRCode [Reset]
82getTerminalWidth :: IO (Maybe Int)
83getTerminalWidth = fmap TerminalSize.width <$> TerminalSize.size