-- |
-- Module: Xmobar.Text.Output
-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Fri Feb 4, 2022 01:10
--
--
-- Format strings emitted by Commands into output strings
--
------------------------------------------------------------------------------

module Xmobar.Text.Output (initLoop, format) where

import Xmobar.Config.Types (Config(textOutputFormat, additionalFonts, font)
                           , TextOutputFormat(..))
import Xmobar.Run.Parsers ( Segment
                          , Widget(..)
                          , parseString
                          , tColorsString
                          , colorComponents)

import Xmobar.Text.Ansi (withAnsiColor)
import Xmobar.Text.Pango (withPangoMarkup)
import Xmobar.Text.Swaybar (formatSwaybar, prepare)

initLoop :: Config -> IO ()
initLoop :: Config -> IO ()
initLoop Config
conf = case Config -> TextOutputFormat
textOutputFormat Config
conf of
  TextOutputFormat
Swaybar -> IO ()
prepare
  TextOutputFormat
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

formatWithColor :: Config -> Segment -> String
formatWithColor :: Config -> Segment -> String
formatWithColor Config
conf (Text String
s, TextRenderInfo
info, FontIndex
idx, Maybe [Action]
_) =
  case Config -> TextOutputFormat
textOutputFormat Config
conf of
    TextOutputFormat
Ansi -> (String, String) -> String -> String
withAnsiColor (String
fg, String
bg) String
s
    TextOutputFormat
Pango -> String -> String -> String -> String -> String
withPangoMarkup String
fg String
bg String
fn String
s
    TextOutputFormat
_ -> String
s
  where (String
fg, String
bg) = Config -> String -> (String, String)
colorComponents Config
conf (TextRenderInfo -> String
tColorsString TextRenderInfo
info)
        fonts :: [String]
fonts = Config -> [String]
additionalFonts Config
conf
        fn :: String
fn = if FontIndex
idx FontIndex -> FontIndex -> Bool
forall a. Ord a => a -> a -> Bool
< FontIndex
1 Bool -> Bool -> Bool
|| FontIndex
idx FontIndex -> FontIndex -> Bool
forall a. Ord a => a -> a -> Bool
> [String] -> FontIndex
forall (t :: * -> *) a. Foldable t => t a -> FontIndex
length [String]
fonts
             then Config -> String
font Config
conf
             else [String]
fonts [String] -> FontIndex -> String
forall a. [a] -> FontIndex -> a
!! (FontIndex
idx FontIndex -> FontIndex -> FontIndex
forall a. Num a => a -> a -> a
- FontIndex
1)
formatWithColor Config
conf (Hspace Int32
n, TextRenderInfo
i, FontIndex
x, Maybe [Action]
y) =
   Config -> Segment -> String
formatWithColor Config
conf (String -> Widget
Text (String -> Widget) -> String -> Widget
forall a b. (a -> b) -> a -> b
$ FontIndex -> Char -> String
forall a. FontIndex -> a -> [a]
replicate (Int32 -> FontIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n) Char
' ', TextRenderInfo
i, FontIndex
x, Maybe [Action]
y)
formatWithColor Config
_ Segment
_ = String
""

format :: Config -> String -> IO String
format :: Config -> String -> IO String
format Config
conf String
s = do
  [Segment]
segments <- Config -> String -> IO [Segment]
parseString Config
conf String
s
  case Config -> TextOutputFormat
textOutputFormat Config
conf of
    TextOutputFormat
Swaybar -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Config -> [Segment] -> String
formatSwaybar Config
conf [Segment]
segments
    TextOutputFormat
_ -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ((Segment -> String) -> [Segment] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Config -> Segment -> String
formatWithColor Config
conf) [Segment]
segments)