]> Git — Sourcephile - haskell/symantic-document.git/blob - src/Symantic/Formatter/Debug.hs
doc: update `ChangeLog.md`
[haskell/symantic-document.git] / src / Symantic / Formatter / Debug.hs
1 {-# LANGUAGE UndecidableInstances #-} -- For IsString (repr ())
2 module Symantic.Formatter.Debug where
3
4 import Data.Function (($))
5 import Data.Semigroup ((<>))
6 import Data.String (String, IsString(..))
7 import Symantic.Formatter.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