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 world’s largest e-mail service with MSN Hotmail. http://www.hotmail.com _______________________________________________ Haskell mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell