<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html> <head> <!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ --> <title>src/Darcs/ColorPrinter.hs</title> <link type='text/css' rel='stylesheet' href='hscolour.css' /> </head> <body> <pre><a name="line-1"></a><span class='hs-comment'>{-# OPTIONS -fno-warn-orphans #-}</span> <a name="line-2"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>ColorPrinter</span> <span class='hs-layout'>(</span> <span class='hs-varid'>errorDoc</span><span class='hs-layout'>,</span> <span class='hs-varid'>traceDoc</span><span class='hs-layout'>,</span> <span class='hs-varid'>assertDoc</span><span class='hs-layout'>,</span> <span class='hs-varid'>fancyPrinters</span> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span> <a name="line-3"></a> <a name="line-4"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Debug</span><span class='hs-varop'>.</span><span class='hs-conid'>Trace</span> <span class='hs-layout'>(</span> <span class='hs-varid'>trace</span> <span class='hs-layout'>)</span> <a name="line-5"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span> <span class='hs-layout'>(</span> <span class='hs-varid'>stderr</span> <span class='hs-layout'>)</span> <a name="line-6"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Darcs</span><span class='hs-varop'>.</span><span class='hs-conid'>External</span> <span class='hs-layout'>(</span><span class='hs-varid'>getTermNColors</span><span class='hs-layout'>)</span> <a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Printer</span> <span class='hs-layout'>(</span><span class='hs-conid'>Printer</span><span class='hs-layout'>,</span> <span class='hs-conid'>Printers</span><span class='hs-layout'>,</span> <span class='hs-conid'>Printers'</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Printable</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Color</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <a name="line-8"></a> <span class='hs-varid'>invisiblePrinter</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varop'><></span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varop'><?></span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Doc</span><span class='hs-layout'>(</span><span class='hs-conid'>Doc</span><span class='hs-layout'>,</span><span class='hs-varid'>unDoc</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>unsafeBothText</span><span class='hs-layout'>,</span> <span class='hs-varid'>simplePrinter</span><span class='hs-layout'>,</span> <span class='hs-varid'>hcat</span><span class='hs-layout'>,</span> <a name="line-9"></a> <span class='hs-varid'>unsafeText</span><span class='hs-layout'>,</span> <span class='hs-varid'>unsafePackedString</span><span class='hs-layout'>,</span> <a name="line-10"></a> <span class='hs-varid'>renderStringWith</span><span class='hs-layout'>,</span> <span class='hs-varid'>prefix</span> <span class='hs-layout'>)</span> <a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Char</span> <span class='hs-layout'>(</span> <span class='hs-varid'>isAscii</span><span class='hs-layout'>,</span> <span class='hs-varid'>isPrint</span><span class='hs-layout'>,</span> <span class='hs-varid'>isSpace</span><span class='hs-layout'>,</span> <span class='hs-varid'>isControl</span><span class='hs-layout'>,</span> <span class='hs-varid'>ord</span><span class='hs-layout'>,</span> <span class='hs-varid'>chr</span> <span class='hs-layout'>)</span> <a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Bits</span> <span class='hs-layout'>(</span> <span class='hs-varid'>bit</span><span class='hs-layout'>,</span> <span class='hs-varid'>xor</span> <span class='hs-layout'>)</span> <a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Environment</span> <span class='hs-layout'>(</span> <span class='hs-varid'>getEnv</span> <span class='hs-layout'>)</span> <a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>ByteString</span><span class='hs-varop'>.</span><span class='hs-conid'>Char8</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>BC</span> <span class='hs-layout'>(</span><span class='hs-varid'>unpack</span><span class='hs-layout'>,</span> <span class='hs-varid'>any</span><span class='hs-layout'>,</span> <span class='hs-varid'>last</span><span class='hs-layout'>,</span> <span class='hs-varid'>spanEnd</span><span class='hs-layout'>)</span> <a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>ByteString</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>B</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span><span class='hs-layout'>,</span> <span class='hs-varid'>init</span><span class='hs-layout'>)</span> <a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>Unsafe</span> <span class='hs-layout'>(</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-layout'>)</span> <a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span> <span class='hs-layout'>(</span> <span class='hs-varid'>hIsTerminalDevice</span><span class='hs-layout'>,</span> <span class='hs-conid'>Handle</span> <span class='hs-layout'>)</span> <a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Printf</span> <span class='hs-layout'>(</span> <span class='hs-varid'>printf</span> <span class='hs-layout'>)</span> <a name="line-19"></a> <a name="line-20"></a><a name="dollar"></a><span class='hs-definition'>dollar</span><span class='hs-layout'>,</span> <span class='hs-varid'>cr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Doc</span> <a name="line-21"></a><span class='hs-definition'>dollar</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-str'>"$"</span> <a name="line-22"></a><a name="cr"></a><span class='hs-definition'>cr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-str'>"\r"</span> <a name="line-23"></a> <a name="line-24"></a><a name="errorDoc"></a><span class='hs-definition'>errorDoc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <a name="line-25"></a><span class='hs-definition'>errorDoc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-varop'>.</span> <span class='hs-varid'>show</span> <a name="line-26"></a> <a name="line-27"></a><a name="traceDoc"></a><span class='hs-definition'>traceDoc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <a name="line-28"></a><span class='hs-definition'>traceDoc</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>trace</span> <span class='hs-layout'>(</span><span class='hs-varid'>show</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span> <a name="line-29"></a> <a name="line-30"></a><a name="assertDoc"></a><span class='hs-definition'>assertDoc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <a name="line-31"></a><span class='hs-definition'>assertDoc</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span> <a name="line-32"></a><span class='hs-definition'>assertDoc</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>errorDoc</span> <span class='hs-varid'>e</span> <a name="line-33"></a> <a name="line-34"></a><a name="instance%20Show%20Doc"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Show</span> <span class='hs-conid'>Doc</span> <span class='hs-keyword'>where</span> <a name="line-35"></a> <span class='hs-varid'>show</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>renderStringWith</span> <span class='hs-layout'>(</span><span class='hs-varid'>fancyPrinters</span> <span class='hs-varid'>stderr</span><span class='hs-layout'>)</span> <a name="line-36"></a> <a name="line-37"></a><a name="Policy"></a><span class='hs-comment'>-- policy</span> <a name="line-38"></a><a name="Policy"></a><span class='hs-comment'>-- | the 'Policy' type is a record containing the variables which control</span> <a name="line-39"></a><a name="Policy"></a><span class='hs-comment'>-- how 'Doc's will be rendered on some output.</span> <a name="line-40"></a><a name="Policy"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Policy</span> <span class='hs-layout'>{</span> <span class='hs-varid'>poColor</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ overall use of color</span> <a name="line-41"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poEscape</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ overall use of escaping</span> <a name="line-42"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poLineColor</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ overall use of colored lines (only hunks for now)</span> <a name="line-43"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poAltColor</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ alternative to color (bold, inverse)</span> <a name="line-44"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poIsprint</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ don't escape isprints</span> <a name="line-45"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>po8bit</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ don't escape 8-bit chars</span> <a name="line-46"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poNoEscX</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-comment'>-- ^ extra chars to never escape</span> <a name="line-47"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poEscX</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-comment'>-- ^ extra chars to always escape</span> <a name="line-48"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poTrailing</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ escape trailing spaces</span> <a name="line-49"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poCR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ ignore \r at end of lines</span> <a name="line-50"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>poSpace</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- ^ escape spaces (used with poTrailing)</span> <a name="line-51"></a> <span class='hs-layout'>}</span> <a name="line-52"></a> <a name="line-53"></a><a name="getPolicy"></a><span class='hs-comment'>{-# NOINLINE getPolicy #-}</span> <a name="line-54"></a><span class='hs-comment'>-- | 'getPolicy' returns a suitable policy for a given handle.</span> <a name="line-55"></a><span class='hs-comment'>-- The policy is chosen according to environment variables, and to the</span> <a name="line-56"></a><span class='hs-comment'>-- type of terminal which the handle represents</span> <a name="line-57"></a><span class='hs-definition'>getPolicy</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Handle</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Policy</span> <a name="line-58"></a><span class='hs-definition'>getPolicy</span> <span class='hs-varid'>handle</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-varop'>$</span> <a name="line-59"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>isTerminal</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>hIsTerminalDevice</span> <span class='hs-varid'>handle</span> <a name="line-60"></a> <span class='hs-varid'>nColors</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>isTerminal</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>getTermNColors</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-num'>0</span> <a name="line-61"></a> <a name="line-62"></a> <span class='hs-varid'>envDontEscapeAnything</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DONT_ESCAPE_ANYTHING"</span> <a name="line-63"></a> <span class='hs-varid'>envDontEscapeIsprint</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DONT_ESCAPE_ISPRINT"</span> <a name="line-64"></a> <span class='hs-varid'>envUseIsprint</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_USE_ISPRINT"</span> <span class='hs-comment'>-- for backwards-compatibility</span> <a name="line-65"></a> <span class='hs-varid'>envDontEscape8bit</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DONT_ESCAPE_8BIT"</span> <a name="line-66"></a> <a name="line-67"></a> <span class='hs-varid'>envDontEscapeExtra</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvString</span> <span class='hs-str'>"DARCS_DONT_ESCAPE_EXTRA"</span> <a name="line-68"></a> <span class='hs-varid'>envEscapeExtra</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvString</span> <span class='hs-str'>"DARCS_ESCAPE_EXTRA"</span> <a name="line-69"></a> <a name="line-70"></a> <span class='hs-varid'>envDontEscapeTrailingSpace</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DONT_ESCAPE_TRAILING_SPACES"</span> <a name="line-71"></a> <span class='hs-varid'>envDontEscapeTrailingCR</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DONT_ESCAPE_TRAILING_CR"</span> <a name="line-72"></a> <a name="line-73"></a> <span class='hs-varid'>envDontColor</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DONT_COLOR"</span> <a name="line-74"></a> <span class='hs-varid'>envAlwaysColor</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_ALWAYS_COLOR"</span> <a name="line-75"></a> <span class='hs-varid'>envAlternativeColor</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_ALTERNATIVE_COLOR"</span> <a name="line-76"></a> <span class='hs-varid'>envDoColorLines</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEnvBool</span> <span class='hs-str'>"DARCS_DO_COLOR_LINES"</span> <a name="line-77"></a> <a name="line-78"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>haveColor</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>envAlwaysColor</span> <span class='hs-varop'>||</span> <span class='hs-layout'>(</span><span class='hs-varid'>isTerminal</span> <span class='hs-varop'>&&</span> <span class='hs-layout'>(</span><span class='hs-varid'>nColors</span> <span class='hs-varop'>></span> <span class='hs-num'>4</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-79"></a> <span class='hs-varid'>doColor</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-varid'>envDontColor</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>haveColor</span> <a name="line-80"></a> <a name="line-81"></a> <span class='hs-varid'>return</span> <span class='hs-conid'>Policy</span> <span class='hs-layout'>{</span> <span class='hs-varid'>poColor</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>doColor</span><span class='hs-layout'>,</span> <a name="line-82"></a> <span class='hs-varid'>poEscape</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-varid'>envDontEscapeAnything</span><span class='hs-layout'>,</span> <a name="line-83"></a> <span class='hs-varid'>poLineColor</span><span class='hs-keyglyph'>=</span> <span class='hs-varid'>doColor</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>envDoColorLines</span><span class='hs-layout'>,</span> <a name="line-84"></a> <span class='hs-varid'>poIsprint</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>envDontEscapeIsprint</span> <span class='hs-varop'>||</span> <span class='hs-varid'>envUseIsprint</span><span class='hs-layout'>,</span> <a name="line-85"></a> <span class='hs-varid'>po8bit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>envDontEscape8bit</span><span class='hs-layout'>,</span> <a name="line-86"></a> <span class='hs-varid'>poNoEscX</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>envDontEscapeExtra</span><span class='hs-layout'>,</span> <a name="line-87"></a> <span class='hs-varid'>poEscX</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>envEscapeExtra</span><span class='hs-layout'>,</span> <a name="line-88"></a> <span class='hs-varid'>poTrailing</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-varid'>envDontEscapeTrailingSpace</span><span class='hs-layout'>,</span> <a name="line-89"></a> <span class='hs-varid'>poCR</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>envDontEscapeTrailingCR</span><span class='hs-layout'>,</span> <a name="line-90"></a> <span class='hs-varid'>poAltColor</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>haveColor</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>envAlternativeColor</span><span class='hs-layout'>,</span> <a name="line-91"></a> <a name="line-92"></a> <span class='hs-varid'>poSpace</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <a name="line-93"></a> <span class='hs-layout'>}</span> <a name="line-94"></a> <span class='hs-keyword'>where</span> <a name="line-95"></a> <span class='hs-varid'>getEnvBool</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>safeGetEnv</span> <span class='hs-varid'>s</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>return</span><span class='hs-varop'>.</span><span class='hs-layout'>(</span><span class='hs-varop'>/=</span> <span class='hs-str'>"0"</span><span class='hs-layout'>)</span> <a name="line-96"></a> <span class='hs-varid'>safeGetEnv</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getEnv</span> <span class='hs-varid'>s</span> <span class='hs-varop'>`catch`</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-str'>"0"</span> <a name="line-97"></a> <span class='hs-varid'>getEnvString</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getEnv</span> <span class='hs-varid'>s</span> <span class='hs-varop'>`catch`</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-str'>""</span> <a name="line-98"></a> <a name="line-99"></a> <a name="line-100"></a><span class='hs-comment'>-- printers</span> <a name="line-101"></a> <a name="line-102"></a><a name="fancyPrinters"></a><span class='hs-comment'>-- | @'fancyPrinters' h@ returns a set of printers suitable for outputting</span> <a name="line-103"></a><span class='hs-comment'>-- to @h@</span> <a name="line-104"></a><span class='hs-definition'>fancyPrinters</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Printers</span> <a name="line-105"></a><span class='hs-definition'>fancyPrinters</span> <span class='hs-varid'>h</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>policy</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getPolicy</span> <span class='hs-varid'>h</span> <span class='hs-keyword'>in</span> <a name="line-106"></a> <span class='hs-conid'>Printers</span> <span class='hs-layout'>{</span> <span class='hs-varid'>colorP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>colorPrinter</span> <span class='hs-varid'>policy</span><span class='hs-layout'>,</span> <a name="line-107"></a> <span class='hs-varid'>invisibleP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>invisiblePrinter</span><span class='hs-layout'>,</span> <a name="line-108"></a> <span class='hs-varid'>hiddenP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>colorPrinter</span> <span class='hs-varid'>policy</span> <span class='hs-conid'>Green</span><span class='hs-layout'>,</span> <a name="line-109"></a> <span class='hs-varid'>userchunkP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>userchunkPrinter</span> <span class='hs-varid'>policy</span><span class='hs-layout'>,</span> <a name="line-110"></a> <span class='hs-varid'>defP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>policy</span><span class='hs-layout'>,</span> <a name="line-111"></a> <span class='hs-varid'>lineColorT</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lineColorTrans</span> <span class='hs-varid'>policy</span><span class='hs-layout'>,</span> <a name="line-112"></a> <span class='hs-varid'>lineColorS</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lineColorSuffix</span> <span class='hs-varid'>policy</span> <a name="line-113"></a> <span class='hs-layout'>}</span> <a name="line-114"></a> <a name="line-115"></a><a name="lineColorTrans"></a><span class='hs-comment'>-- | @'lineColorTrans' policy@ tries to color a Doc, according to policy po.</span> <a name="line-116"></a><span class='hs-comment'>-- That is, if @policy@ has @poLineColor@ set, then colors the line, otherwise</span> <a name="line-117"></a><span class='hs-comment'>-- does nothing.</span> <a name="line-118"></a><span class='hs-definition'>lineColorTrans</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Color</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-119"></a><span class='hs-definition'>lineColorTrans</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poLineColor</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-varid'>d</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>prefix</span> <span class='hs-layout'>(</span><span class='hs-varid'>setColor</span> <span class='hs-varid'>c</span><span class='hs-layout'>)</span> <span class='hs-varid'>d</span> <span class='hs-varop'><?></span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-varid'>resetColor</span> <a name="line-120"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>const</span> <span class='hs-varid'>id</span> <a name="line-121"></a> <a name="line-122"></a><a name="lineColorSuffix"></a><span class='hs-definition'>lineColorSuffix</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Printable</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Printable</span><span class='hs-keyglyph'>]</span> <a name="line-123"></a><span class='hs-definition'>lineColorSuffix</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poLineColor</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>d</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>S</span> <span class='hs-varid'>resetColor</span> <span class='hs-conop'>:</span> <span class='hs-varid'>d</span> <a name="line-124"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span> <a name="line-125"></a> <a name="line-126"></a><a name="colorPrinter"></a><span class='hs-definition'>colorPrinter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Color</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Printer</span> <a name="line-127"></a><span class='hs-definition'>colorPrinter</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poColor</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unDoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>color</span> <span class='hs-varid'>po</span> <span class='hs-varid'>c</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Doc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span><span class='hs-layout'>{</span><span class='hs-varid'>poColor</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>}</span> <a name="line-128"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>const</span> <span class='hs-varop'>$</span> <span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span> <a name="line-129"></a> <a name="line-130"></a><a name="userchunkPrinter"></a><span class='hs-definition'>userchunkPrinter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Printer</span> <a name="line-131"></a><span class='hs-definition'>userchunkPrinter</span> <span class='hs-varid'>po</span> <span class='hs-varid'>p</span> <a name="line-132"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>poEscape</span> <span class='hs-varid'>po</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>simplePrinter</span> <span class='hs-varid'>p</span> <a name="line-133"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>poTrailing</span> <span class='hs-varid'>po</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span> <span class='hs-varid'>p</span> <a name="line-134"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unDoc</span> <span class='hs-varop'>$</span> <span class='hs-varid'>pr</span> <span class='hs-varid'>p</span> <a name="line-135"></a> <span class='hs-keyword'>where</span> <a name="line-136"></a> <span class='hs-varid'>pr</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>prString</span> <span class='hs-varid'>s</span> <a name="line-137"></a> <span class='hs-varid'>pr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Both</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>prPS</span> <span class='hs-varid'>ps</span> <a name="line-138"></a> <span class='hs-varid'>pr</span> <span class='hs-layout'>(</span><span class='hs-conid'>PS</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>prPS</span> <span class='hs-varid'>ps</span> <a name="line-139"></a> <a name="line-140"></a> <span class='hs-varid'>prPS</span> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>leadPS</span><span class='hs-layout'>,</span> <span class='hs-varid'>trailPS</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>BC</span><span class='hs-varop'>.</span><span class='hs-varid'>spanEnd</span> <span class='hs-varid'>isSpace</span> <span class='hs-varid'>ps</span> <a name="line-141"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>if</span> <span class='hs-conid'>B</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>trailPS</span> <a name="line-142"></a> <span class='hs-keyword'>then</span> <span class='hs-conid'>Doc</span> <span class='hs-varop'>$</span> <span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span> <span class='hs-varid'>p</span> <a name="line-143"></a> <span class='hs-keyword'>else</span> <span class='hs-conid'>Doc</span> <span class='hs-layout'>(</span><span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-conid'>PS</span> <span class='hs-varid'>leadPS</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-144"></a> <span class='hs-varop'><></span> <span class='hs-conid'>Doc</span> <span class='hs-layout'>(</span><span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span><span class='hs-layout'>{</span><span class='hs-varid'>poSpace</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>True</span><span class='hs-layout'>}</span> <span class='hs-layout'>(</span><span class='hs-conid'>PS</span> <span class='hs-varid'>trailPS</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-145"></a> <span class='hs-varop'><></span> <span class='hs-varid'>markEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>dollar</span> <a name="line-146"></a> <a name="line-147"></a> <span class='hs-varid'>prString</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>trail'</span><span class='hs-layout'>,</span><span class='hs-varid'>lead'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>span</span> <span class='hs-varid'>isSpace</span> <span class='hs-layout'>(</span><span class='hs-varid'>reverse</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <a name="line-148"></a> <span class='hs-varid'>lead</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reverse</span> <span class='hs-varid'>lead'</span> <a name="line-149"></a> <span class='hs-varid'>trail</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>reverse</span> <span class='hs-varid'>trail'</span> <a name="line-150"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>if</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span><span class='hs-layout'>)</span> <span class='hs-varid'>trail</span> <a name="line-151"></a> <span class='hs-keyword'>then</span> <span class='hs-conid'>Doc</span> <span class='hs-layout'>(</span><span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span> <span class='hs-varid'>lead</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-152"></a> <span class='hs-varop'><></span> <span class='hs-conid'>Doc</span> <span class='hs-layout'>(</span><span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span><span class='hs-layout'>{</span><span class='hs-varid'>poSpace</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>True</span><span class='hs-layout'>}</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span> <span class='hs-varid'>trail</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <a name="line-153"></a> <span class='hs-varop'><></span> <span class='hs-varid'>markEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>dollar</span> <a name="line-154"></a> <span class='hs-keyword'>else</span> <span class='hs-conid'>Doc</span> <span class='hs-layout'>(</span><span class='hs-varid'>escapePrinter</span> <span class='hs-varid'>po</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <a name="line-155"></a> <a name="line-156"></a><a name="escapePrinter"></a><span class='hs-definition'>escapePrinter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Printer</span> <a name="line-157"></a><span class='hs-definition'>escapePrinter</span> <span class='hs-varid'>po</span> <a name="line-158"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span><span class='hs-varop'>.</span><span class='hs-varid'>poEscape</span><span class='hs-layout'>)</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>simplePrinter</span> <a name="line-159"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unDoc</span> <span class='hs-varop'>.</span> <span class='hs-varid'>crepr</span> <a name="line-160"></a> <span class='hs-keyword'>where</span> <a name="line-161"></a> <span class='hs-varid'>crepr</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poCR</span> <span class='hs-varid'>po</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isEndCR</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>epr</span> <span class='hs-layout'>(</span><span class='hs-varid'>initPR</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-varop'><></span> <span class='hs-varid'>cr</span> <a name="line-162"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>epr</span> <span class='hs-varid'>p</span> <a name="line-163"></a> <a name="line-164"></a> <span class='hs-varid'>epr</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>escape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>s</span> <a name="line-165"></a> <span class='hs-varid'>epr</span> <span class='hs-layout'>(</span><span class='hs-conid'>PS</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-conid'>BC</span><span class='hs-varop'>.</span><span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span><span class='hs-varop'>.</span><span class='hs-varid'>noEscape</span> <span class='hs-varid'>po</span><span class='hs-layout'>)</span> <span class='hs-varid'>ps</span> <a name="line-166"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>escape</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-conid'>BC</span><span class='hs-varop'>.</span><span class='hs-varid'>unpack</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <a name="line-167"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>unsafePackedString</span> <span class='hs-varid'>ps</span> <a name="line-168"></a> <span class='hs-varid'>epr</span> <span class='hs-layout'>(</span><span class='hs-conid'>Both</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>escape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>s</span> <a name="line-169"></a> <a name="line-170"></a> <span class='hs-varid'>isEndCR</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>last</span> <span class='hs-varid'>s</span> <span class='hs-varop'>==</span> <span class='hs-chr'>'\r'</span> <a name="line-171"></a> <span class='hs-varid'>isEndCR</span> <span class='hs-layout'>(</span><span class='hs-conid'>PS</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-conid'>B</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-conid'>BC</span><span class='hs-varop'>.</span><span class='hs-varid'>last</span> <span class='hs-varid'>ps</span> <span class='hs-varop'>==</span> <span class='hs-chr'>'\r'</span> <a name="line-172"></a> <span class='hs-varid'>isEndCR</span> <span class='hs-layout'>(</span><span class='hs-conid'>Both</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-conid'>B</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span> <span class='hs-conid'>BC</span><span class='hs-varop'>.</span><span class='hs-varid'>last</span> <span class='hs-varid'>ps</span> <span class='hs-varop'>==</span> <span class='hs-chr'>'\r'</span> <a name="line-173"></a> <a name="line-174"></a> <span class='hs-varid'>initPR</span> <span class='hs-layout'>(</span><span class='hs-conid'>S</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>S</span> <span class='hs-varop'>$</span> <span class='hs-varid'>init</span> <span class='hs-varid'>s</span> <a name="line-175"></a> <span class='hs-varid'>initPR</span> <span class='hs-layout'>(</span><span class='hs-conid'>PS</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>PS</span> <span class='hs-varop'>$</span> <span class='hs-conid'>B</span><span class='hs-varop'>.</span><span class='hs-varid'>init</span> <span class='hs-varid'>ps</span> <a name="line-176"></a> <span class='hs-varid'>initPR</span> <span class='hs-layout'>(</span><span class='hs-conid'>Both</span> <span class='hs-varid'>s</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Both</span> <span class='hs-layout'>(</span><span class='hs-varid'>init</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>B</span><span class='hs-varop'>.</span><span class='hs-varid'>init</span> <span class='hs-varid'>ps</span><span class='hs-layout'>)</span> <a name="line-177"></a> <a name="line-178"></a> <a name="line-179"></a><a name="escape"></a><span class='hs-comment'>-- | @'escape' policy string@ escapes @string@ according to the rules</span> <a name="line-180"></a><span class='hs-comment'>-- defined in 'policy', turning it into a 'Doc'.</span> <a name="line-181"></a><span class='hs-definition'>escape</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-182"></a><span class='hs-definition'>escape</span> <span class='hs-keyword'>_</span> <span class='hs-str'>""</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafeText</span> <span class='hs-str'>""</span> <a name="line-183"></a><span class='hs-definition'>escape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>hcat</span> <span class='hs-varop'>$</span> <span class='hs-varid'>escape'</span> <span class='hs-varid'>s</span> <a name="line-184"></a> <span class='hs-keyword'>where</span> <a name="line-185"></a> <span class='hs-varid'>escape'</span> <span class='hs-str'>""</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span> <a name="line-186"></a> <span class='hs-varid'>escape'</span> <span class='hs-varid'>s'</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-conop'>:</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>mundane</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <a name="line-187"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>printables</span><span class='hs-layout'>,</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>span</span> <span class='hs-varid'>mundane</span> <span class='hs-varid'>s'</span> <span class='hs-keyword'>in</span> <a name="line-188"></a> <span class='hs-layout'>(</span><span class='hs-varid'>unsafeText</span> <span class='hs-varid'>printables</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-layout'>(</span><span class='hs-varid'>escape'</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <a name="line-189"></a> <span class='hs-varid'>escape'</span> <span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-conop'>:</span><span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>emph</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unsafeText</span> <span class='hs-varop'>$</span> <span class='hs-varid'>quoteChar</span> <span class='hs-varid'>c</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-layout'>(</span><span class='hs-varid'>escape'</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <a name="line-190"></a> <span class='hs-varid'>mundane</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>noEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>c</span><span class='hs-layout'>)</span> <span class='hs-varop'>||</span> <span class='hs-layout'>(</span><span class='hs-varid'>c</span> <span class='hs-varop'>==</span> <span class='hs-chr'>' '</span><span class='hs-layout'>)</span> <a name="line-191"></a> <span class='hs-varid'>emph</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>markEscape</span> <span class='hs-varid'>po</span><span class='hs-layout'>)</span> <a name="line-192"></a> <a name="line-193"></a> <a name="line-194"></a><a name="noEscape"></a><span class='hs-comment'>-- | @'noEscape' policy c@ tells wether @c@ will be left as-is</span> <a name="line-195"></a><span class='hs-comment'>-- when escaping according to @policy@</span> <a name="line-196"></a><span class='hs-definition'>noEscape</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Char</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <a name="line-197"></a><span class='hs-definition'>noEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poSpace</span> <span class='hs-varid'>po</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isSpace</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <a name="line-198"></a><span class='hs-definition'>noEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>c</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>poEscX</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <a name="line-199"></a><span class='hs-definition'>noEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>c</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>poNoEscX</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <a name="line-200"></a><span class='hs-definition'>noEscape</span> <span class='hs-keyword'>_</span> <span class='hs-chr'>'\t'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <span class='hs-comment'>-- tabs will likely be converted to spaces</span> <a name="line-201"></a><span class='hs-definition'>noEscape</span> <span class='hs-keyword'>_</span> <span class='hs-chr'>'\n'</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span> <a name="line-202"></a><span class='hs-definition'>noEscape</span> <span class='hs-varid'>po</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-layout'>(</span><span class='hs-varid'>poIsprint</span> <span class='hs-varid'>po</span><span class='hs-layout'>)</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>isPrint</span> <span class='hs-varid'>c</span> <a name="line-203"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>isPrintableAscii</span> <span class='hs-varid'>c</span> <a name="line-204"></a> <span class='hs-varop'>||</span> <span class='hs-varid'>c</span> <span class='hs-varop'>>=</span> <span class='hs-chr'>'\x80'</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>po8bit</span> <span class='hs-varid'>po</span> <a name="line-205"></a> <a name="line-206"></a><a name="isPrintableAscii"></a><span class='hs-comment'>-- | 'isPrintableAscii' tells wether a character is a printable character</span> <a name="line-207"></a><span class='hs-comment'>-- of the ascii range.</span> <a name="line-208"></a><span class='hs-definition'>isPrintableAscii</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Char</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span> <a name="line-209"></a><span class='hs-definition'>isPrintableAscii</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isAscii</span> <span class='hs-varid'>c</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isPrint</span> <span class='hs-varid'>c</span> <a name="line-210"></a> <a name="line-211"></a> <a name="line-212"></a><a name="quoteChar"></a><span class='hs-comment'>-- | 'quoteChar' represents a special character as a string.</span> <a name="line-213"></a><span class='hs-comment'>-- * @quoteChar '^c'@ (where @^c@ is a control character) is @"^c"@</span> <a name="line-214"></a><span class='hs-comment'>-- * Otherwise, @quoteChar@ returns "\hex", where 'hex' is the</span> <a name="line-215"></a><span class='hs-comment'>-- hexadecimal number of the character.</span> <a name="line-216"></a><span class='hs-definition'>quoteChar</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Char</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <a name="line-217"></a><span class='hs-definition'>quoteChar</span> <span class='hs-varid'>c</span> <a name="line-218"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isControl</span> <span class='hs-varid'>c</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>isPrintableAscii</span> <span class='hs-varid'>cHat</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-chr'>'^'</span><span class='hs-layout'>,</span> <span class='hs-varid'>cHat</span><span class='hs-keyglyph'>]</span> <a name="line-219"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>sHex</span> <a name="line-220"></a> <span class='hs-keyword'>where</span> <a name="line-221"></a> <span class='hs-varid'>cHat</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>chr</span> <span class='hs-varop'>$</span> <span class='hs-layout'>(</span><span class='hs-varid'>bit</span> <span class='hs-num'>6</span> <span class='hs-varop'>`xor`</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>ord</span> <span class='hs-varid'>c</span> <a name="line-222"></a> <span class='hs-varid'>sHex</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"<U+"</span> <span class='hs-varop'>++</span> <span class='hs-varid'>printf</span> <span class='hs-str'>"%04X"</span> <span class='hs-varid'>c</span> <span class='hs-varop'>++</span> <span class='hs-str'>">"</span> <a name="line-223"></a> <a name="line-224"></a> <a name="line-225"></a><span class='hs-comment'>-- make colors and highlightings</span> <a name="line-226"></a> <a name="line-227"></a><a name="markEscape"></a><span class='hs-comment'>-- | @'markEscape' policy doc@ marks @doc@ with the appropriate</span> <a name="line-228"></a><span class='hs-comment'>-- marking for escaped characters according to @policy@</span> <a name="line-229"></a><span class='hs-definition'>markEscape</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-230"></a><span class='hs-definition'>markEscape</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poAltColor</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeInvert</span> <a name="line-231"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poColor</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor</span> <span class='hs-conid'>Red</span> <a name="line-232"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeAsciiart</span> <a name="line-233"></a> <a name="line-234"></a><a name="color"></a><span class='hs-comment'>-- | @'color' policy color doc@ colors @doc@ with color @color@ if</span> <a name="line-235"></a><span class='hs-comment'>-- @policy@ is not set to use an alternative to color. In that case,</span> <a name="line-236"></a><span class='hs-comment'>-- it makes the text bold instead.</span> <a name="line-237"></a><span class='hs-definition'>color</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Policy</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Color</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-238"></a><span class='hs-definition'>color</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>poAltColor</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>makeBold</span> <a name="line-239"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor</span> <a name="line-240"></a> <a name="line-241"></a><a name="makeColor"></a><span class='hs-definition'>makeColor</span><span class='hs-layout'>,</span> <span class='hs-varid'>makeColor'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Color</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-242"></a> <a name="line-243"></a><a name="makeColor'"></a><span class='hs-definition'>makeColor'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withColor</span> <span class='hs-varop'>.</span> <span class='hs-varid'>setColor</span> <a name="line-244"></a> <a name="line-245"></a><span class='hs-comment'>-- memoized version of makeColor'</span> <a name="line-246"></a><span class='hs-definition'>makeColor</span> <span class='hs-conid'>Blue</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor'</span> <span class='hs-conid'>Blue</span> <a name="line-247"></a><span class='hs-definition'>makeColor</span> <span class='hs-conid'>Red</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor'</span> <span class='hs-conid'>Red</span> <a name="line-248"></a><span class='hs-definition'>makeColor</span> <span class='hs-conid'>Green</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor'</span> <span class='hs-conid'>Green</span> <a name="line-249"></a><span class='hs-definition'>makeColor</span> <span class='hs-conid'>Cyan</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor'</span> <span class='hs-conid'>Cyan</span> <a name="line-250"></a><span class='hs-definition'>makeColor</span> <span class='hs-conid'>Magenta</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeColor'</span> <span class='hs-conid'>Magenta</span> <a name="line-251"></a> <a name="line-252"></a><a name="setColor"></a><span class='hs-definition'>setColor</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Color</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <a name="line-253"></a><span class='hs-definition'>setColor</span> <span class='hs-conid'>Blue</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\x1B[01;34m"</span> <span class='hs-comment'>-- bold blue</span> <a name="line-254"></a><span class='hs-definition'>setColor</span> <span class='hs-conid'>Red</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\x1B[01;31m"</span> <span class='hs-comment'>-- bold red</span> <a name="line-255"></a><span class='hs-definition'>setColor</span> <span class='hs-conid'>Green</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\x1B[01;32m"</span> <span class='hs-comment'>-- bold green</span> <a name="line-256"></a><span class='hs-definition'>setColor</span> <span class='hs-conid'>Cyan</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\x1B[36m"</span> <span class='hs-comment'>-- light cyan</span> <a name="line-257"></a><span class='hs-definition'>setColor</span> <span class='hs-conid'>Magenta</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\x1B[35m"</span> <span class='hs-comment'>-- light magenta</span> <a name="line-258"></a> <a name="line-259"></a><a name="makeAsciiart"></a><span class='hs-comment'>-- | @'makeAsciiart' doc@ tries to make @doc@ (usually a</span> <a name="line-260"></a><span class='hs-comment'>-- single escaped char) stand out with the help of only plain</span> <a name="line-261"></a><span class='hs-comment'>-- ascii, i.e., no color or font style.</span> <a name="line-262"></a><span class='hs-definition'>makeAsciiart</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-263"></a><span class='hs-definition'>makeAsciiart</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-str'>"[_"</span> <span class='hs-varop'><></span> <span class='hs-varid'>x</span> <span class='hs-varop'><></span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-str'>"_]"</span> <a name="line-264"></a> <a name="line-265"></a><a name="resetColor"></a><span class='hs-comment'>-- | the string to reset the terminal's color.</span> <a name="line-266"></a><span class='hs-definition'>resetColor</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <a name="line-267"></a><span class='hs-definition'>resetColor</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\x1B[00m"</span> <a name="line-268"></a> <a name="line-269"></a><a name="withColor"></a><span class='hs-comment'>-- | @'withColor' color doc@ returns a colorized version of @doc@.</span> <a name="line-270"></a><span class='hs-comment'>-- @color@ is a string that represents a color, given by 'setColor'</span> <a name="line-271"></a><span class='hs-definition'>withColor</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-272"></a><span class='hs-definition'>withColor</span> <span class='hs-varid'>c</span> <span class='hs-keyglyph'>=</span> <a name="line-273"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>c'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-varid'>c</span> <a name="line-274"></a> <span class='hs-varid'>r'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafeBothText</span> <span class='hs-varid'>resetColor</span> <a name="line-275"></a> <span class='hs-keyword'>in</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>c'</span> <span class='hs-varop'><></span> <span class='hs-varid'>x</span> <span class='hs-varop'><></span> <span class='hs-varid'>r'</span> <a name="line-276"></a> <a name="line-277"></a> <a name="line-278"></a><a name="makeBold"></a><span class='hs-comment'>-- | 'makeBold' boldens a doc.</span> <a name="line-279"></a><span class='hs-definition'>makeBold</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-280"></a><a name="makeInvert"></a><span class='hs-comment'>-- | 'makeInvert' returns an invert video version of a doc.</span> <a name="line-281"></a><span class='hs-definition'>makeInvert</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Doc</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Doc</span> <a name="line-282"></a><span class='hs-definition'>makeBold</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withColor</span> <span class='hs-str'>"\x1B[01m"</span> <a name="line-283"></a><span class='hs-definition'>makeInvert</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withColor</span> <span class='hs-str'>"\x1B[07m"</span> </pre></body> </html>