{-# LANGUAGE ScopedTypeVariables #-}
module Htcc.Utils.Print (
putStrErr, putStrLnErr, err,
putDocLn, putDocErr, putDocLnErr,
errTxtDoc, errCharDoc, warnTxtDoc,
warnCharDoc, locTxtDoc, locCharDoc,
) where
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Prelude hiding (toInteger)
import System.Exit (exitFailure)
import System.IO (stderr)
import Text.PrettyPrint.ANSI.Leijen (Doc, bold, char, hPutDoc,
linebreak, magenta, putDoc, red,
text)
{-# INLINE putDocLn #-}
putDocLn :: Doc -> IO ()
putDocLn :: Doc -> IO ()
putDocLn = Doc -> IO ()
putDoc (Doc -> IO ()) -> (Doc -> Doc) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) Doc
linebreak
{-# INLINE putDocErr #-}
putDocErr :: Doc -> IO ()
putDocErr :: Doc -> IO ()
putDocErr = Handle -> Doc -> IO ()
hPutDoc Handle
stderr
{-# INLINE putDocLnErr #-}
putDocLnErr :: Doc -> IO ()
putDocLnErr :: Doc -> IO ()
putDocLnErr = Doc -> IO ()
putDocErr (Doc -> IO ()) -> (Doc -> Doc) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) Doc
linebreak
{-# INLINE errTxtDoc #-}
errTxtDoc :: String -> Doc
errTxtDoc :: String -> Doc
errTxtDoc = Doc -> Doc
red (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text
{-# INLINE errCharDoc #-}
errCharDoc :: Char -> Doc
errCharDoc :: Char -> Doc
errCharDoc = Doc -> Doc
red (Doc -> Doc) -> (Char -> Doc) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
char
{-# INLINE warnTxtDoc #-}
warnTxtDoc :: String -> Doc
warnTxtDoc :: String -> Doc
warnTxtDoc = Doc -> Doc
magenta (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text
{-# INLINE warnCharDoc #-}
warnCharDoc :: Char -> Doc
warnCharDoc :: Char -> Doc
warnCharDoc = Doc -> Doc
magenta (Doc -> Doc) -> (Char -> Doc) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
char
{-# INLINE locTxtDoc #-}
locTxtDoc :: String -> Doc
locTxtDoc :: String -> Doc
locTxtDoc = Doc -> Doc
bold (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text
{-# INLINE locCharDoc #-}
locCharDoc :: Char -> Doc
locCharDoc :: Char -> Doc
locCharDoc = Doc -> Doc
bold (Doc -> Doc) -> (Char -> Doc) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Doc
char
putStrLnErr :: T.Text -> IO ()
putStrLnErr :: Text -> IO ()
putStrLnErr = Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr
putStrErr :: T.Text -> IO ()
putStrErr :: Text -> IO ()
putStrErr = Handle -> Text -> IO ()
T.hPutStr Handle
stderr
err :: T.Text -> IO ()
err :: Text -> IO ()
err = (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) IO ()
forall a. IO a
exitFailure (IO () -> IO ()) -> (Text -> IO ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
putStrLnErr