src/Symantic/Plaintext/Debug.hs

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