-- For IsString (repr ())
{-# LANGUAGE UndecidableInstances #-}

module Symantic.Plaintext.Debug where

import Data.Function (($))
import Data.Semigroup ((<>))
import Data.String (IsString (..), String)
import Symantic.Plaintext.Classes

newtype XML repr a = XML {unXML :: repr a}

-- | For debugging purposes.
instance
  ( ProductFunctor repr
  , IsString (repr ())
  ) =>
  Colorable16 (XML repr)
  where
  reverse = xmlSGR "reverse"
  black = xmlSGR "black"
  red = xmlSGR "red"
  green = xmlSGR "green"
  yellow = xmlSGR "yellow"
  blue = xmlSGR "blue"
  magenta = xmlSGR "magenta"
  cyan = xmlSGR "cyan"
  white = xmlSGR "white"
  blacker = xmlSGR "blacker"
  redder = xmlSGR "redder"
  greener = xmlSGR "greener"
  yellower = xmlSGR "yellower"
  bluer = xmlSGR "bluer"
  magentaer = xmlSGR "magentaer"
  cyaner = xmlSGR "cyaner"
  whiter = xmlSGR "whiter"
  onBlack = xmlSGR "onBlack"
  onRed = xmlSGR "onRed"
  onGreen = xmlSGR "onGreen"
  onYellow = xmlSGR "onYellow"
  onBlue = xmlSGR "onBlue"
  onMagenta = xmlSGR "onMagenta"
  onCyan = xmlSGR "onCyan"
  onWhite = xmlSGR "onWhite"
  onBlacker = xmlSGR "onBlacker"
  onRedder = xmlSGR "onRedder"
  onGreener = xmlSGR "onGreener"
  onYellower = xmlSGR "onYellower"
  onBluer = xmlSGR "onBluer"
  onMagentaer = xmlSGR "onMagentaer"
  onCyaner = xmlSGR "onCyaner"
  onWhiter = xmlSGR "onWhiter"

xmlSGR ::
  IsString (repr ()) =>
  ProductFunctor repr =>
  String ->
  XML repr a ->
  XML repr a
xmlSGR newSGR s =
  XML $
    fromString ("<" <> newSGR <> ">")
      .> unXML s
        <. fromString ("</" <> newSGR <> ">")