module Hix.Console where

import qualified Data.ByteString.Char8 as ByteString
import qualified Data.Text.IO as Text
import Exon (exon)
import System.IO (Handle, stderr, stdout)

hPrint ::
  MonadIO m =>
  Handle ->
  Text ->
  m ()
hPrint :: forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
hPrint Handle
h Text
msg =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
h Text
msg)

hPrintBS ::
  MonadIO m =>
  Handle ->
  ByteString ->
  m ()
hPrintBS :: forall (m :: * -> *). MonadIO m => Handle -> ByteString -> m ()
hPrintBS Handle
h ByteString
msg =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
ByteString.hPutStrLn Handle
h ByteString
msg)

out :: MonadIO m => Text -> m ()
out :: forall (m :: * -> *). MonadIO m => Text -> m ()
out = Handle -> Text -> m ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
hPrint Handle
stdout

err :: MonadIO m => Text -> m ()
err :: forall (m :: * -> *). MonadIO m => Text -> m ()
err = Handle -> Text -> m ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
hPrint Handle
stderr

bytesOut :: MonadIO m => ByteString -> m ()
bytesOut :: forall (m :: * -> *). MonadIO m => ByteString -> m ()
bytesOut = Handle -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Handle -> ByteString -> m ()
hPrintBS Handle
stdout

bytesErr :: MonadIO m => ByteString -> m ()
bytesErr :: forall (m :: * -> *). MonadIO m => ByteString -> m ()
bytesErr = Handle -> ByteString -> m ()
forall (m :: * -> *). MonadIO m => Handle -> ByteString -> m ()
hPrintBS Handle
stderr

sgi :: Text -> Text
sgi :: Text -> Text
sgi Text
param =
  [exon|#{esc}[#{param}m|]
  where
    esc :: Text
esc = Text
"\ESC"

sgis :: [Text] -> Text -> Text
sgis :: [Text] -> Text -> Text
sgis [Text]
params Text
chunk =
  [exon|#{seqs}#{chunk}#{sgi "0"}|]
  where
    seqs :: Text
seqs = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Text -> Text
sgi (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
params)

color :: Int -> Text -> Text
color :: Int -> Text -> Text
color Int
n =
  [Text] -> Text -> Text
sgis [Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)]

data ColorOffsets =
  ColorOffsets {
    ColorOffsets -> Int
black :: Int,
    ColorOffsets -> Int
red :: Int,
    ColorOffsets -> Int
green :: Int,
    ColorOffsets -> Int
yellow :: Int,
    ColorOffsets -> Int
blue :: Int,
    ColorOffsets -> Int
magenta :: Int,
    ColorOffsets -> Int
cyan :: Int,
    ColorOffsets -> Int
white :: Int
  }
  deriving stock (ColorOffsets -> ColorOffsets -> Bool
(ColorOffsets -> ColorOffsets -> Bool)
-> (ColorOffsets -> ColorOffsets -> Bool) -> Eq ColorOffsets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorOffsets -> ColorOffsets -> Bool
== :: ColorOffsets -> ColorOffsets -> Bool
$c/= :: ColorOffsets -> ColorOffsets -> Bool
/= :: ColorOffsets -> ColorOffsets -> Bool
Eq, Int -> ColorOffsets -> ShowS
[ColorOffsets] -> ShowS
ColorOffsets -> String
(Int -> ColorOffsets -> ShowS)
-> (ColorOffsets -> String)
-> ([ColorOffsets] -> ShowS)
-> Show ColorOffsets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorOffsets -> ShowS
showsPrec :: Int -> ColorOffsets -> ShowS
$cshow :: ColorOffsets -> String
show :: ColorOffsets -> String
$cshowList :: [ColorOffsets] -> ShowS
showList :: [ColorOffsets] -> ShowS
Show, (forall x. ColorOffsets -> Rep ColorOffsets x)
-> (forall x. Rep ColorOffsets x -> ColorOffsets)
-> Generic ColorOffsets
forall x. Rep ColorOffsets x -> ColorOffsets
forall x. ColorOffsets -> Rep ColorOffsets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColorOffsets -> Rep ColorOffsets x
from :: forall x. ColorOffsets -> Rep ColorOffsets x
$cto :: forall x. Rep ColorOffsets x -> ColorOffsets
to :: forall x. Rep ColorOffsets x -> ColorOffsets
Generic)

colors :: ColorOffsets
colors :: ColorOffsets
colors =
  ColorOffsets {
    black :: Int
black = Int
0,
    red :: Int
red = Int
1,
    green :: Int
green = Int
2,
    yellow :: Int
yellow = Int
3,
    blue :: Int
blue = Int
4,
    magenta :: Int
magenta = Int
5,
    cyan :: Int
cyan = Int
6,
    white :: Int
white = Int
7
  }

withChevrons :: Int -> Text -> Text
withChevrons :: Int -> Text -> Text
withChevrons Int
col Text
msg =
  [exon|#{sgis [show (30 + col), "1"] ">>>"} #{msg}|]

errorMessage :: Text -> Text
errorMessage :: Text -> Text
errorMessage Text
msg =
  Int -> Text -> Text
withChevrons Int
1 [exon|Error: #{msg}|]