modulePrinter(Printable(..),Doc(Doc,unDoc),Printers,Printers'(..),Printer,Color(..),hPutDoc,hPutDocLn,putDoc,putDocLn,hPutDocWith,hPutDocLnWith,putDocWith,putDocLnWith,renderString,renderStringWith,renderPS,renderPSWith,renderPSs,renderPSsWith,lineColor,prefix,insertBeforeLastline,colorText,invisibleText,hiddenText,hiddenPrefix,userchunk,text,printable,wrapText,blueText,redText,greenText,magentaText,cyanText,unsafeText,unsafeBoth,unsafeBothText,unsafeChar,invisiblePS,packedString,unsafePackedString,userchunkPS,simplePrinters,invisiblePrinter,simplePrinter,doc,empty,(<>),(<?>),(<+>),($$),vcat,vsep,hcat,minus,newline,plus,space,backslash,lparen,rparen,parens,errorDoc,)whereimportData.List(intersperse)importSystem.IO(Handle,stdout,hPutStr)importByteStringUtils(linesPS)importqualifiedData.ByteStringasB(ByteString,hPut,concat)importqualifiedData.ByteString.Char8asBC(unpack,pack,singleton)-- | A 'Printable' is either a String, a packed string, or a chunk of-- text with both representations.dataPrintable=S!String|PS!B.ByteString|Both!String!B.ByteString-- | 'spaceP' is the 'Printable' representation of a space.spaceP::PrintablespaceP=Both" "(BC.singleton' ')-- | 'newlineP' is the 'Printable' representation of a newline.newlineP::PrintablenewlineP=S"\n"-- | Minimal 'Doc's representing the common characters 'space', 'newline'-- 'minus', 'plus', and 'backslash'.space,newline,plus,minus,backslash::Docspace=unsafeBoth" "(BC.singleton' ')newline=unsafeChar'\n'minus=unsafeBoth"-"(BC.singleton'-')plus=unsafeBoth"+"(BC.singleton'+')backslash=unsafeBoth"\\"(BC.singleton'\\')-- | 'lparen' is the 'Doc' that represents @\"(\"@lparen::Doclparen=unsafeBoth"("(BC.singleton'(')-- | 'rparen' is the 'Doc' that represents @\")\"@rparen::Docrparen=unsafeBoth")"(BC.singleton')')-- | @'parens' doc@ returns a 'Doc' with the content of @doc@ put within-- a pair of parenthesis.parens::Doc->Docparensd=lparen<>d<>rparenerrorDoc::Doc->aerrorDoc=error.renderStringWithsimplePrinters'-- | 'putDocWith' puts a doc on stdout using the given printer.putDocWith::Printers->Doc->IO()putDocWithprs=hPutDocWithprsstdout-- | 'putDocLnWith' puts a doc, followed by a newline on stdout using-- the given printer.putDocLnWith::Printers->Doc->IO()putDocLnWithprs=hPutDocLnWithprsstdout-- | 'putDoc' puts a doc on stdout using the simple printer 'simplePrinters'.putDoc::Doc->IO()-- | 'putDocLn' puts a doc, followed by a newline on stdout using-- 'simplePrinters'putDocLn::Doc->IO()putDoc=hPutDocstdoutputDocLn=hPutDocLnstdout-- | 'hputDocWith' puts a doc on the given handle using the given printer.hPutDocWith::Printers->Handle->Doc->IO()-- | 'hputDocLnWith' puts a doc, followed by a newline on the given-- handle using the given printer.hPutDocLnWith::Printers->Handle->Doc->IO()hPutDocWithprshd=hPrintPrintablesh(renderWith(prsh)d)hPutDocLnWithprshd=hPutDocWithprsh(d<?>newline)-- |'hputDoc' puts a doc on the given handle using 'simplePrinters'hPutDoc::Handle->Doc->IO()-- 'hputDocLn' puts a doc, followed by a newline on the given handle using-- 'simplePrinters'.hPutDocLn::Handle->Doc->IO()hPutDoc=hPutDocWithsimplePrintershPutDocLn=hPutDocLnWithsimplePrinters-- | @'hPrintPrintables' h@ prints a list of 'Printable's to the handle hhPrintPrintables::Handle->[Printable]->IO()hPrintPrintablesh=mapM_(hPrintPrintableh)-- | @hPrintPrintable h@ prints a 'Printable' to the handle h.hPrintPrintable::Handle->Printable->IO()hPrintPrintableh(Sps)=hPutStrhpshPrintPrintableh(PSps)=B.hPuthpshPrintPrintableh(Both_ps)=B.hPuthps-- | a 'Doc' is a bit of enriched text. 'Doc's get concatanated using-- '<>', which is right-associative.newtypeDoc=Doc{unDoc::St->Document}-- | The State associated with a doc. Contains a set of printers for each-- hanlde, and the current prefix of the document.dataSt=St{printers::!Printers',currentPrefix::!([Printable]->[Printable])}typePrinters=Handle->Printers'-- | A set of printers to print different types of text to a handle.dataPrinters'=Printers{colorP::!(Color->Printer),invisibleP::!Printer,hiddenP::!Printer,userchunkP::!Printer,defP::!Printer,lineColorT::!(Color->Doc->Doc),lineColorS::!([Printable]->[Printable])}typePrinter=Printable->St->DocumentdataColor=Blue|Red|Green|Cyan|Magenta-- | 'Document' is a wrapper around '[Printable] -> [Printable]' which allows-- for empty Documents. The simplest 'Documents' are built from 'String's-- using 'text'.dataDocument=Document([Printable]->[Printable])|Empty-- | renders a 'Doc' into a 'String' with control codes for the-- special features of the doc.renderString::Doc->StringrenderString=renderStringWithsimplePrinters'-- | renders a 'Doc' into a 'String' using a given set of printers.renderStringWith::Printers'->Doc->StringrenderStringWithprsd=concatMaptoString$renderWithprsdwheretoString(Ss)=stoString(PSps)=BC.unpackpstoString(Boths_)=s-- | renders a 'Doc' into 'B.ByteString' with control codes for the-- special features of the Doc. See also 'readerString'.renderPS::Doc->B.ByteStringrenderPS=renderPSWithsimplePrinters'-- | renders a 'Doc' into a list of 'PackedStrings', one for each line.renderPSs::Doc->[B.ByteString]renderPSs=renderPSsWithsimplePrinters'-- | renders a doc into a 'B.ByteString' using a given set of printers.renderPSWith::Printers'->Doc->B.ByteStringrenderPSWithprsd=B.concat$renderPSsWithprsd-- | renders a 'Doc' into a list of 'PackedStrings', one for each-- chunk of text that was added to the doc, using the given set of-- printers.renderPSsWith::Printers'->Doc->[B.ByteString]renderPSsWithprsd=maptoPS$renderWithprsdwheretoPS(Ss)=BC.packstoPS(PSps)=pstoPS(Both_ps)=ps-- | renders a 'Doc' into a list of 'Printables' using a set of-- printers. Each item of the list corresponds to a string that was-- added to the doc.renderWith::Printers'->Doc->[Printable]renderWithps(Docd)=cased(initStateps)ofEmpty->[]Documentf->f[]initState::Printers'->StinitStateprs=St{printers=prs,currentPrefix=id}prefix::String->Doc->Docprefixs(Docd)=Doc$\st->letp=Ssst'=st{currentPrefix=currentPrefixst.(p:)}incasedst'ofDocumentd''->Document$(p:).d''Empty->EmptyinsertBeforeLastline::Doc->Doc->DocinsertBeforeLastlineab=casereverse$mappackedString$linesPS$renderPSaof(ll:ls)->vcat(reversels)$$b$$ll[]->error"empty Doc given as first argument of Printer.insert_before_last_line"lineColor::Color->Doc->DoclineColorcd=Doc$\st->caselineColorT(printersst)cdofDocd'->d'sthiddenPrefix::String->Doc->DochiddenPrefixs(Docd)=Doc$\st->letpr=printersstp=S(renderStringWithpr$hiddenTexts)st'=st{currentPrefix=currentPrefixst.(p:)}incasedst'ofDocumentd''->Document$(p:).d''Empty->Empty-- | 'unsafeBoth' builds a Doc from a 'String' and a 'B.ByteString' representing-- the same text, but does not check that they do.unsafeBoth::String->B.ByteString->DocunsafeBothsps=Doc$simplePrinter(Bothsps)-- | 'unsafeBothText' builds a 'Doc' from a 'String'. The string is stored in the-- Doc as both a String and a 'B.ByteString'.unsafeBothText::String->DocunsafeBothTexts=Doc$simplePrinter(Boths(BC.packs))-- | 'packedString' builds a 'Doc' from a 'B.ByteString' using 'printable'packedString::B.ByteString->Doc-- | 'unsafePackedString' builds a 'Doc' from a 'B.ByteString' using 'simplePrinter'unsafePackedString::B.ByteString->Doc-- | 'invisiblePS' creates a 'Doc' with invisible text from a 'B.ByteString'invisiblePS::B.ByteString->Doc-- | 'userchunkPS' creates a 'Doc' representing a user chunk from a 'B.ByteString'.userchunkPS::B.ByteString->DocpackedString=printable.PSunsafePackedString=Doc.simplePrinter.PSinvisiblePS=invisiblePrintable.PSuserchunkPS=userchunkPrintable.PS-- | 'unsafeChar' creates a Doc containing just one character.unsafeChar::Char->DocunsafeChar=unsafeText.(:"")-- | 'text' creates a 'Doc' from a @String@, using 'printable'.text::String->Doc-- | 'unsafeText' creates a 'Doc' from a 'String', using 'simplePrinter' directlyunsafeText::String->Doc-- | 'invisibleText' creates a 'Doc' containing invisible text from a @String@invisibleText::String->Doc-- | 'hiddenText' creates a 'Doc' containing hidden text from a @String@hiddenText::String->Doc-- | 'userchunk' creates a 'Doc' containing a user chunk from a @String@userchunk::String->Doc-- | 'blueText' creates a 'Doc' containing blue text from a @String@blueText,redText,greenText,magentaText,cyanText::String->Doctext=printable.SunsafeText=Doc.simplePrinter.SinvisibleText=invisiblePrintable.ShiddenText=hiddenPrintable.Suserchunk=userchunkPrintable.SblueText=colorTextBlueredText=colorTextRedgreenText=colorTextGreenmagentaText=colorTextMagentacyanText=colorTextCyan-- | 'colorText' creates a 'Doc' containing colored text from a @String@colorText::Color->String->DoccolorTextc=mkColorPrintablec.S-- | @'wrapText' n s@ is a 'Doc' representing @s@ line-wrapped at 'n' characterswrapText::Int->String->DocwrapTextns=vcat$maptext$reverse$"":(foldladd_to_line[]$wordss)whereadd_to_line[]a=[a]add_to_line("":d)a=(a:d)add_to_line(l:ls)new|lengthl+lengthnew>n=new:l:lsadd_to_line(l:ls)new=(l++" "++new):ls-- | 'printable x' creates a 'Doc' from any 'Printable'.printable,invisiblePrintable,hiddenPrintable,userchunkPrintable::Printable->Docprintablex=Doc$\st->defP(printersst)xstmkColorPrintable::Color->Printable->DocmkColorPrintablecx=Doc$\st->colorP(printersst)cxstinvisiblePrintablex=Doc$\st->invisibleP(printersst)xsthiddenPrintablex=Doc$\st->hiddenP(printersst)xstuserchunkPrintablex=Doc$\st->userchunkP(printersst)xst-- | 'simplePrinters' is a 'Printers' which uses the set 'simplePriners\'' on any-- handle.simplePrinters::PrinterssimplePrinters_=simplePrinters'-- | A set of default printers suitable for any handle. Does not use color.simplePrinters'::Printers'simplePrinters'=Printers{colorP=constsimplePrinter,invisibleP=simplePrinter,hiddenP=invisiblePrinter,userchunkP=simplePrinter,defP=simplePrinter,lineColorT=constid,lineColorS=id}-- | 'simplePrinter' is the simplest 'Printer': it just concatenates together-- the pieces of the 'Doc'simplePrinter::Printer-- | 'invisiblePrinter' is the 'Printer' for hidden text. It just replaces-- the document with 'empty'. It's useful to have a printer that doesn't-- actually do anything because this allows you to have tunable policies,-- for example, only printing some text if it's to the terminal, but not-- if it's to a file or vice-versa.invisiblePrinter::PrintersimplePrinterx=unDoc$doc(\s->x:s)invisiblePrinter_=unDocemptyinfixr6<>infixr6<+>infixr5$$-- | The empty 'Doc'.empty::Docempty=Doc$constEmptydoc::([Printable]->[Printable])->Docdocf=Doc$const$Documentf-- | '(<>)' is the concatenation operator for 'Doc's(<>)::Doc->Doc->Doc-- | @a '<?>' b@ is @a <> b@ if @a@ is not empty, else empty.(<?>)::Doc->Doc->Doc-- | @a '<+>' b@ is @a@ followed by a space, then @b@.(<+>)::Doc->Doc->Doc-- | @a '$$' b@ is @a@ above @b@.($$)::Doc->Doc->Doc-- a then bDoca<>Docb=Doc$\st->caseastofEmpty->bstDocumentaf->Document(\s->af$casebstofEmpty->sDocumentbf->bfs)-- empty if a empty, else a then bDoca<?>Docb=Doc$\st->caseastofEmpty->EmptyDocumentaf->Document(\s->af$casebstofEmpty->sDocumentbf->bfs)-- a then space then bDoca<+>Docb=Doc$\st->caseastofEmpty->bstDocumentaf->Document(\s->af$casebstofEmpty->sDocumentbf->spaceP:bfs)-- a above bDoca$$Docb=Doc$\st->caseastofEmpty->bstDocumentaf->Document(\s->af$casebstofEmpty->sDocumentbf->sf(newlineP:pf(bfs)))wherepf=currentPrefixstsf=lineColorS$printersst-- | 'vcat' piles vertically a list of 'Doc's.vcat::[Doc]->Docvcat[]=emptyvcatds=foldr1($$)ds-- | 'vsep' piles vertically a list of 'Doc's leaving a blank line between each.vsep::[Doc]->Docvsep[]=emptyvsepds=foldr1($$)$intersperse(text"")ds-- | 'hcat' concatenates (horizontally) a list of 'Doc'shcat::[Doc]->Dochcat[]=emptyhcatds=foldr1(<>)ds