------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Text.Pango
-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Author: Pavel Kalugin
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Fri Feb 4, 2022 01:15
--
--
-- Codification with Pango markup
--
------------------------------------------------------------------------------

module Xmobar.Text.Pango (withPangoColor, withPangoFont, withPangoMarkup) where

import Text.Printf (printf)
import Data.List (isPrefixOf)

replaceAll :: (Eq a) => a -> [a] -> [a] -> [a]
replaceAll :: a -> [a] -> [a] -> [a]
replaceAll a
c [a]
s = (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c then [a]
s else [a
x])

xmlEscape :: String -> String
xmlEscape :: String -> String
xmlEscape String
s = Char -> String -> String -> String
forall a. Eq a => a -> [a] -> [a] -> [a]
replaceAll Char
'"' String
""" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
              Char -> String -> String -> String
forall a. Eq a => a -> [a] -> [a] -> [a]
replaceAll Char
'\'' String
"'" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
              Char -> String -> String -> String
forall a. Eq a => a -> [a] -> [a] -> [a]
replaceAll Char
'<' String
"&lt;" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
              Char -> String -> String -> String
forall a. Eq a => a -> [a] -> [a] -> [a]
replaceAll Char
'>' String
"&gt;" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
              Char -> String -> String -> String
forall a. Eq a => a -> [a] -> [a] -> [a]
replaceAll Char
'&' String
"&amp;" String
s

withPangoColor :: (String, String) -> String -> String
withPangoColor :: (String, String) -> String -> String
withPangoColor (String
fg, String
bg) String
s =
  String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
fmt (String -> String
xmlEscape String
fg) (String -> String
xmlEscape String
bg) (String -> String
xmlEscape String
s)
  where fmt :: String
fmt = String
"<span foreground=\"%s\" background=\"%s\">%s</span>"

fixXft :: String -> String
fixXft :: String -> String
fixXft String
font = if String
"xft:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
font then Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
font else String
font

withPangoFont :: String -> String -> String
withPangoFont :: String -> String -> String
withPangoFont String
font String
txt = String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
fmt (String -> String
fixXft String
font) (String -> String
xmlEscape String
txt)
  where fmt :: String
fmt = String
"<span font=\"%s\">%s</span>"

withPangoMarkup :: String -> String -> String -> String -> String
withPangoMarkup :: String -> String -> String -> String -> String
withPangoMarkup String
fg String
bg String
font String
txt =
  String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
fmt (String -> String
fixXft String
font) (String -> String
xmlEscape String
fg) (String -> String
xmlEscape String
bg) (String -> String
xmlEscape String
txt)
  where fmt :: String
fmt = String
"<span font=\"%s\" foreground=\"%s\" background=\"%s\">%s</span>"