src/Symantic/Document/Debug.hs

   1 {-# LANGUAGE UndecidableInstances #-} -- For IsString (repr ())
   2 module Symantic.Document.Debug where
   3
   4 import Data.Function (($))
   5 import Data.Semigroup ((<>))
   6 import Data.String (String, IsString(..))
   7 import Symantic.Document.Class
   8
   9 newtype XML repr a = XML { unXML :: repr a }
  10
  11 -- | For debugging purposes.
  12 instance
  13   ( ProductFunctor repr
  14   , IsString (repr ())
  15   ) => Colorable16 (XML repr) where
  16   reverse     = xmlSGR "reverse"
  17   black       = xmlSGR "black"
  18   red         = xmlSGR "red"
  19   green       = xmlSGR "green"
  20   yellow      = xmlSGR "yellow"
  21   blue        = xmlSGR "blue"
  22   magenta     = xmlSGR "magenta"
  23   cyan        = xmlSGR "cyan"
  24   white       = xmlSGR "white"
  25   blacker     = xmlSGR "blacker"
  26   redder      = xmlSGR "redder"
  27   greener     = xmlSGR "greener"
  28   yellower    = xmlSGR "yellower"
  29   bluer       = xmlSGR "bluer"
  30   magentaer   = xmlSGR "magentaer"
  31   cyaner      = xmlSGR "cyaner"
  32   whiter      = xmlSGR "whiter"
  33   onBlack     = xmlSGR "onBlack"
  34   onRed       = xmlSGR "onRed"
  35   onGreen     = xmlSGR "onGreen"
  36   onYellow    = xmlSGR "onYellow"
  37   onBlue      = xmlSGR "onBlue"
  38   onMagenta   = xmlSGR "onMagenta"
  39   onCyan      = xmlSGR "onCyan"
  40   onWhite     = xmlSGR "onWhite"
  41   onBlacker   = xmlSGR "onBlacker"
  42   onRedder    = xmlSGR "onRedder"
  43   onGreener   = xmlSGR "onGreener"
  44   onYellower  = xmlSGR "onYellower"
  45   onBluer     = xmlSGR "onBluer"
  46   onMagentaer = xmlSGR "onMagentaer"
  47   onCyaner    = xmlSGR "onCyaner"
  48   onWhiter    = xmlSGR "onWhiter"
  49
  50 xmlSGR ::
  51   IsString (repr ()) =>
  52   ProductFunctor repr =>
  53   String -> XML repr a -> XML repr a
  54 xmlSGR newSGR s = XML $
  55   fromString ("<"<>newSGR<>">")
  56   .> unXML s <.
  57   fromString ("</"<>newSGR<>">")
  58