{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-
Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111(-1)307 USA
-}{- |
Module : Text.Pandoc.Pretty
Copyright : Copyright (C) 2010 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
A prettyprinting library for the production of text documents,
including wrapped text, indentated blocks, and tables.
-}moduleText.Pandoc.Pretty(Doc,render,cr,blankline,space,text,char,prefixed,flush,nest,hang,beforeNonBlank,nowrap,offset,height,lblock,cblock,rblock,(<>),(<+>),($$),($+$),isEmpty,empty,cat,hcat,hsep,vcat,vsep,chomp,inside,braces,brackets,parens,quotes,doubleQuotes,charWidth,realLength)whereimportData.Sequence(Seq,fromList,(<|),singleton,mapWithIndex)importData.Foldable(toList)importData.List(intercalate)importData.MonoidimportData.StringimportControl.Monad.StateimportData.Char(isSpace)dataMonoida=>RenderStatea=RenderState{output::[a]-- ^ In reverse order,prefix::String,usePrefix::Bool,lineLength::MaybeInt-- ^ 'Nothing' means no wrapping,column::Int,newlines::Int-- ^ Number of preceding newlines}typeDocStatea=State(RenderStatea)()dataD=TextIntString|BlockInt[String]|PrefixedStringDoc|BeforeNonBlankDoc|FlushDoc|BreakingSpace|CarriageReturn|NewLine|BlankLinederiving(Show)newtypeDoc=Doc{unDoc::SeqD}deriving(Monoid)instanceShowDocwhereshow=renderNothinginstanceIsStringDocwherefromString=textisBlank::D->BoolisBlankBreakingSpace=TrueisBlankCarriageReturn=TrueisBlankNewLine=TrueisBlankBlankLine=TrueisBlank(Text_(c:_))=isSpacecisBlank_=False-- | True if the document is empty.isEmpty::Doc->BoolisEmpty=null.toList.unDoc-- | The empty document.empty::Docempty=mempty#if MIN_VERSION_base(4,5,0)-- (<>) is defined in Data.Monoid#elseinfixr6<>-- | An infix synonym for 'mappend'.-- @a <> b@ is the result of concatenating @a@ with @b@.(<>)::Monoidm=>m->m->m(<>)=mappend{-# INLINE (<>) #-}#endif-- | Concatenate a list of 'Doc's.cat::[Doc]->Doccat=mconcat-- | Same as 'cat'.hcat::[Doc]->Dochcat=mconcat-- | Concatenate a list of 'Doc's, putting breakable spaces-- between them.infixr6<+>(<+>)::Doc->Doc->Doc(<+>)xy=ifisEmptyxthenyelseifisEmptyythenxelsex<>space<>y-- | Same as 'cat', but putting breakable spaces between the-- 'Doc's.hsep::[Doc]->Dochsep=foldr(<+>)emptyinfixr5$$-- | @a $$ b@ puts @a@ above @b@.($$)::Doc->Doc->Doc($$)xy=ifisEmptyxthenyelseifisEmptyythenxelsex<>cr<>yinfixr5$+$-- | @a $$ b@ puts @a@ above @b@, with a blank line between.($+$)::Doc->Doc->Doc($+$)xy=ifisEmptyxthenyelseifisEmptyythenxelsex<>blankline<>y-- | List version of '$$'.vcat::[Doc]->Docvcat=foldr($$)empty-- | List version of '$+$'.vsep::[Doc]->Docvsep=foldr($+$)empty-- | Chomps trailing blank space off of a 'Doc'.chomp::Doc->Docchompd=Doc(fromListdl')wheredl=toList(unDocd)dl'=reverse$dropWhileremoveable$reversedlremoveableBreakingSpace=TrueremoveableCarriageReturn=TrueremoveableNewLine=TrueremoveableBlankLine=Trueremoveable_=Falseoutp::(IsStringa,Monoida)=>Int->String->DocStateaoutpoffs|off<=0=dost'<-getletrawpref=prefixst'when(columnst'==0&&usePrefixst'&&not(nullrawpref))$doletpref=reverse$dropWhileisSpace$reverserawprefmodify$\st->st{output=fromStringpref:outputst,column=columnst+realLengthpref}when(off<0)$domodify$\st->st{output=fromStrings:outputst,column=0,newlines=newlinesst+1}outpoffs=dost'<-getletpref=prefixst'when(columnst'==0&&usePrefixst'&&not(nullpref))$domodify$\st->st{output=fromStringpref:outputst,column=columnst+realLengthpref}modify$\st->st{output=fromStrings:outputst,column=columnst+off,newlines=0}-- | Renders a 'Doc'. @render (Just n)@ will use-- a line length of @n@ to reflow text on breakable spaces.-- @render Nothing@ will not reflow text.render::(Monoida,IsStringa)=>MaybeInt->Doc->arenderlinelendoc=fromString.mconcat.reverse.output$execState(renderDocdoc)startingStatewherestartingState=RenderState{output=mempty,prefix="",usePrefix=True,lineLength=linelen,column=0,newlines=2}renderDoc::(IsStringa,Monoida)=>Doc->DocStatearenderDoc=renderList.toList.unDocrenderList::(IsStringa,Monoida)=>[D]->DocStatearenderList[]=return()renderList(Textoffs:xs)=dooutpoffsrenderListxsrenderList(Prefixedprefd:xs)=dost<-getletoldPref=prefixstputst{prefix=prefixst++pref}renderDocdmodify$\s->s{prefix=oldPref}renderListxsrenderList(Flushd:xs)=dost<-getletoldUsePrefix=usePrefixstputst{usePrefix=False}renderDocdmodify$\s->s{usePrefix=oldUsePrefix}renderListxsrenderList(BeforeNonBlankd:xs)=casexsof(x:_)|isBlankx->renderListxs|otherwise->renderDocd>>renderListxs[]->renderListxsrenderList(BlankLine:xs)=dost<-getcaseoutputstof_|newlinesst>1||nullxs->return()_|columnst==0->dooutp(-1)"\n"_->dooutp(-1)"\n"outp(-1)"\n"renderListxsrenderList(CarriageReturn:xs)=dost<-getifnewlinesst>0||nullxsthenrenderListxselsedooutp(-1)"\n"renderListxsrenderList(NewLine:xs)=dooutp(-1)"\n"renderListxsrenderList(BreakingSpace:CarriageReturn:xs)=renderList(CarriageReturn:xs)renderList(BreakingSpace:NewLine:xs)=renderList(NewLine:xs)renderList(BreakingSpace:BlankLine:xs)=renderList(BlankLine:xs)renderList(BreakingSpace:BreakingSpace:xs)=renderList(BreakingSpace:xs)renderList(BreakingSpace:xs)=doletisText(Text__)=TrueisText(Block__)=TrueisText_=FalseletisBreakingSpaceBreakingSpace=TrueisBreakingSpace_=Falseletxs'=dropWhileisBreakingSpacexsletnext=takeWhileisTextxs'st<-getletoff=sum$mapoffsetOfnextcaselineLengthstofJustl|columnst+1+off>l->dooutp(-1)"\n"renderListxs'_->dooutp1" "renderListxs'renderList(b1@Block{}:b2@Block{}:xs)=renderList(mergeBlocksFalseb1b2:xs)renderList(b1@Block{}:BreakingSpace:b2@Block{}:xs)=renderList(mergeBlocksTrueb1b2:xs)renderList(Blockwidthlns:xs)=dost<-getletoldPref=prefixstcasecolumnst-realLengtholdPrefofn|n>0->modify$\s->s{prefix=oldPref++replicaten' '}_->return()renderDoc$blockToDocwidthlnsmodify$\s->s{prefix=oldPref}renderListxsmergeBlocks::Bool->D->D->DmergeBlocksaddSpace(Blockw1lns1)(Blockw2lns2)=Block(w1+w2+ifaddSpacethen1else0)$zipWith(\l1l2->padw1l1++l2)(lns1++empties)(mapsplns2++empties)whereempties=replicate(abs$lengthlns1-lengthlns2)""padns=s++replicate(n-realLengths)' 'sp""=""spxs=ifaddSpacethen(' ':xs)elsexsmergeBlocks___=error"mergeBlocks tried on non-Block!"blockToDoc::Int->[String]->DocblockToDoc_lns=text$intercalate"\n"lnsoffsetOf::D->IntoffsetOf(Texto_)=ooffsetOf(Blockw_)=woffsetOfBreakingSpace=1offsetOf_=0-- | A literal string.text::String->Doctext=Doc.toChunkswheretoChunks::String->SeqDtoChunks[]=memptytoChunkss=casebreak(=='\n')sof([],_:ys)->NewLine<|toChunksys(xs,_:ys)->Text(realLengthxs)xs<|(NewLine<|toChunksys)(xs,[])->singleton$Text(realLengthxs)xs-- | A character.char::Char->Doccharc=text[c]-- | A breaking (reflowable) space.space::Docspace=Doc$singletonBreakingSpace-- | A carriage return. Does nothing if we're at the beginning of-- a line; otherwise inserts a newline.cr::Doccr=Doc$singletonCarriageReturn-- | Inserts a blank line unless one exists already.-- (@blankline <> blankline@ has the same effect as @blankline@.-- If you want multiple blank lines, use @text "\\n\\n"@.blankline::Docblankline=Doc$singletonBlankLine-- | Uses the specified string as a prefix for every line of-- the inside document (except the first, if not at the beginning-- of the line).prefixed::String->Doc->Docprefixedprefdoc=Doc$singleton$Prefixedprefdoc-- | Makes a 'Doc' flush against the left margin.flush::Doc->Docflushdoc=Doc$singleton$Flushdoc-- | Indents a 'Doc' by the specified number of spaces.nest::Int->Doc->Docnestind=prefixed(replicateind' ')-- | A hanging indent. @hang ind start doc@ prints @start@,-- then @doc@, leaving an indent of @ind@ spaces on every-- line but the first.hang::Int->Doc->Doc->Dochangindstartdoc=start<>nestinddoc-- | @beforeNonBlank d@ conditionally includes @d@ unless it is-- followed by blank space.beforeNonBlank::Doc->DocbeforeNonBlankd=Doc$singleton(BeforeNonBlankd)-- | Makes a 'Doc' non-reflowable.nowrap::Doc->Docnowrapdoc=Doc$mapWithIndexreplaceSpace$unDocdocwherereplaceSpace_BreakingSpace=Text1" "replaceSpace_x=x-- | Returns the width of a 'Doc'.offset::Doc->Intoffsetd=casemaprealLength.lines.renderNothing$dof[]->0os->maximumosblock::(String->String)->Int->Doc->Docblockfillerwidth=Doc.singleton.Blockwidth.mapfiller.chopwidth.render(Justwidth)-- | @lblock n d@ is a block of width @n@ characters, with-- text derived from @d@ and aligned to the left.lblock::Int->Doc->Doclblock=blockid-- | Like 'lblock' but aligned to the right.rblock::Int->Doc->Docrblockw=block(\s->replicate(w-realLengths)' '++s)w-- | Like 'lblock' but aligned centered.cblock::Int->Doc->Doccblockw=block(\s->replicate((w-realLengths)`div`2)' '++s)w-- | Returns the height of a block or other 'Doc'.height::Doc->Intheight=length.lines.renderNothingchop::Int->String->[String]chop_[]=[]chopncs=casebreak(=='\n')csof(xs,ys)->iflen<=nthencaseysof[]->[xs](_:[])->[xs,""](_:zs)->xs:chopnzselsetakenxs:chopn(dropnxs++ys)wherelen=realLengthxs-- | Encloses a 'Doc' inside a start and end 'Doc'.inside::Doc->Doc->Doc->Docinsidestartendcontents=start<>contents<>end-- | Puts a 'Doc' in curly braces.braces::Doc->Docbraces=inside(char'{')(char'}')-- | Puts a 'Doc' in square brackets.brackets::Doc->Docbrackets=inside(char'[')(char']')-- | Puts a 'Doc' in parentheses.parens::Doc->Docparens=inside(char'(')(char')')-- | Wraps a 'Doc' in single quotes.quotes::Doc->Docquotes=inside(char'\'')(char'\'')-- | Wraps a 'Doc' in double quotes.doubleQuotes::Doc->DocdoubleQuotes=inside(char'"')(char'"')-- | Returns width of a character in a monospace font: 0 for a combining-- character, 1 for a regular character, 2 for an East Asian wide character.charWidth::Char->IntcharWidthc=casecof_|c<'\x0300'->1|c>='\x0300'&&c<='\x036F'->0-- combining|c>='\x0370'&&c<='\x10FC'->1|c>='\x1100'&&c<='\x115F'->2|c>='\x1160'&&c<='\x11A2'->1|c>='\x11A3'&&c<='\x11A7'->2|c>='\x11A8'&&c<='\x11F9'->1|c>='\x11FA'&&c<='\x11FF'->2|c>='\x1200'&&c<='\x2328'->1|c>='\x2329'&&c<='\x232A'->2|c>='\x232B'&&c<='\x2E31'->1|c>='\x2E80'&&c<='\x303E'->2|c=='\x303F'->1|c>='\x3041'&&c<='\x3247'->2|c>='\x3248'&&c<='\x324F'->1-- ambiguous|c>='\x3250'&&c<='\x4DBF'->2|c>='\x4DC0'&&c<='\x4DFF'->1|c>='\x4E00'&&c<='\xA4C6'->2|c>='\xA4D0'&&c<='\xA95F'->1|c>='\xA960'&&c<='\xA97C'->2|c>='\xA980'&&c<='\xABF9'->1|c>='\xAC00'&&c<='\xD7FB'->2|c>='\xD800'&&c<='\xDFFF'->1|c>='\xE000'&&c<='\xF8FF'->1-- ambiguous|c>='\xF900'&&c<='\xFAFF'->2|c>='\xFB00'&&c<='\xFDFD'->1|c>='\xFE00'&&c<='\xFE0F'->1-- ambiguous|c>='\xFE10'&&c<='\xFE19'->2|c>='\xFE20'&&c<='\xFE26'->1|c>='\xFE30'&&c<='\xFE6B'->2|c>='\xFE70'&&c<='\x16A38'->1|c>='\x1B000'&&c<='\x1B001'->2|c>='\x1D000'&&c<='\x1F1FF'->1|c>='\x1F200'&&c<='\x1F251'->2|c>='\x1F300'&&c<='\x1F773'->1|c>='\x20000'&&c<='\x3FFFD'->2|otherwise->1-- | Get real length of string, taking into account combining and double-wide-- characters.realLength::String->IntrealLength=sum.mapcharWidth