{-# LANGUAGE UndecidableInstances #-} -- For IsString (repr ())
module Symantic.Document.Debug where

import Data.Function (($))
import Data.Semigroup ((<>))
import Data.String (String, IsString(..))
import Symantic.Document.Class

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<>">")