Re: Pretty printing (was: Standard Library for text formatting?)
Hello,
After doing some searching, it seems that "pretty printing" is a prominant "Haskell way" of doing text output. I still am interested in finding a library of standard text formatting (String formatting) functions, but it seems like it might be worth my while investigating pretty printing.
Pretty printing is not very suited for printf like formatting,
I have looked for something simmilar some time ago, but unsuccesfully. Pretty printing libraries are not very useful for breaking paragraphs into lines, distributing spaces evenly, etc. (at least I was not able to persuade them to work like that). I have written following module that implements stupid first-fit algorithm for these purposes; the interface is simmilar to the pretty printing libraries. Zdenek Dvorak module ReportPrinter ( LowDoc,HighDoc, (<>),(<+>),($$),(<$>), int, lowText, text, empty, colon, comma, space, semi, period, brackets, parens, vcat, sep, punctuate, high, nest, par, render ) where data LowDoc=Text String | Join LowDoc LowDoc | Append LowDoc LowDoc | Empty deriving (Show) data HighDoc=HLowDoc LowDoc | Paragraph Int HighDoc | Nest Int HighDoc | Above HighDoc HighDoc | Beside HighDoc HighDoc deriving (Show) (<>)::LowDoc->LowDoc->LowDoc x <> Empty = x Empty <> x = x x <> y = Join x y (<+>)::LowDoc->LowDoc->LowDoc x <+> Empty = x Empty <+> x = x x <+> y = Append x y (<$>)::HighDoc->HighDoc->HighDoc x <$> HLowDoc Empty=x HLowDoc Empty <$> x=x x <$> y=Beside x y ($$)::HighDoc->HighDoc->HighDoc x $$ HLowDoc Empty=x HLowDoc Empty $$ x=x x $$ y=Above x y lowText::String->LowDoc lowText=Text text::String->LowDoc text str=sep $ map lowText $ words str int::Int->LowDoc int=text . show empty::LowDoc empty=Empty colon::LowDoc colon=lowText ":" comma::LowDoc comma=lowText "," space::LowDoc space=lowText " " semi::LowDoc semi=lowText ";" period::LowDoc period=lowText "." brackets::LowDoc->LowDoc brackets doc=lowText "[" <> doc <> lowText "]" parens::LowDoc->LowDoc parens doc=lowText "(" <> doc <> lowText ")" sep::[LowDoc]->LowDoc sep=foldl (<+>) empty high::LowDoc->HighDoc high=HLowDoc vcat::[HighDoc]->HighDoc vcat=foldl ($$) (high empty) punctuate::LowDoc->[LowDoc]->[LowDoc] punctuate _ [] = [] punctuate _ [x] = [x] punctuate pun (h:t) = (h <> pun) : punctuate pun t nest::Int->HighDoc->HighDoc nest=Nest par::Int->HighDoc->HighDoc par=Paragraph render::Int->HighDoc->String render width doc=highRender width 0 0 doc "" highRender::Int->Int->Int->HighDoc->String->String highRender width indFirst indRest doc rest= case doc of HLowDoc lowDoc -> lowRender width indFirst indRest lowDoc rest Paragraph ind pDoc -> highRender width indFirst (indRest+ind) pDoc rest Nest ind pDoc -> highRender width (indFirst+ind) (indRest+ind) pDoc rest Above doc1 doc2 -> highRender width indFirst indRest doc1 $ highRender width indRest indRest doc2 rest Beside doc1 doc2 -> error "Rendering two HighDocs beside not supported." lowRender::Int->Int->Int->LowDoc->String->String lowRender width indFirst indRest doc rest= stringRender width indFirst indRest strs rest where (strs,_) = stringify False doc [] stringify False (Text txt) rest = ((txt,length txt):rest,False) stringify True (Text txt) [] = ([(txt,length txt)],False) stringify True (Text txt) ((txt',len'):rest) = ((txt++txt',length txt+len'):rest,False) stringify join Empty rest = (rest,join) stringify join (Append doc1 doc2) rest = let (rest',join')=stringify join doc2 rest in stringify join' doc1 rest' stringify join (Join doc1 doc2) rest = let (rest',_)=stringify join doc2 rest in stringify True doc1 rest' stringRender::Int->Int->Int->[(String,Int)]->String->String stringRender width indFirst indRest [] rest=rest stringRender width indFirst indRest strs rest= let (lne,rst)=cutLine (width-indFirst) strs rest'=stringRender width indRest indRest rst rest in lineRender (rst==[]) width indFirst lne rest' cutLine tot ((txt,len):t)=(txt:lne',rst) where (lne',rst)=cutLine' (tot-len) t cutLine' ml []=([],[]) cutLine' ml r@((tx,ln):t') | ml>ln = let (lne'',rst')=cutLine' (ml-ln-1) t' in (tx:lne'',rst') | otherwise = ([],r) lineRender::Bool->Int->Int->[String]->String->String lineRender last width ind lne rest=indent ind rslt where totlen = sum $ map length lne words = length lne reqlen = totlen + words - 1 havelen = width - ind distsp = if havelen > reqlen && not last then havelen - reqlen else 0 count = words `div` 2 rslt = distribSpaces count distsp words lne rest indent n = (take n (cycle " ") ++) distribSpaces::Int->Int->Int->[String]->String->String distribSpaces _ _ _ [h] rest = h ++ '\n' : rest distribSpaces count minus plus (h:t) rest = h ++ ' ' : spaced where (spaced,count') = recount count rest' = distribSpaces (count'-minus) minus plus t rest recount cnt | cnt < 0 = let (spaced',cnt')=recount (cnt+plus) in (' ':spaced',cnt') | otherwise = (rest',cnt) _________________________________________________________________ Join the worlds largest e-mail service with MSN Hotmail. http://www.hotmail.com
participants (1)
-
Zdenek Dvorak