-- $Header: /data/cvs-rep/uust/lib/pretty/UU/Pretty/Ext.hs,v 1.1 2002/11/13 16:05:20 uust Exp $ -- $Name: $ (version name) module UU.Pretty.Ext ( -- Derived from single and multiple (>^<), (>>^<<), (>#<), (>>#<<), wide_text , vlist, hlist, hlist_sp, list_h1, hlist_h1 , (>|<<), (>-<<), (>>|<), (>>-<), pp_es -- Displaying the result , vdisp -- Printing brackets , pp_wrap, pp_quotes, pp_doubleQuotes , pp_parens, pp_brackets, pp_braces -- Printing structures , hv, hv_sp, pp_block, pp_ite , pp_list, pp_slist, pp_parens_list ) where {- Derived pretty-printing combinators. Version 2.0c Authors: S. Doaitse Swierstra and Pablo R. Azero Date: July, 1999 -} import UU.Pretty.Basic infixr 3 >#<, >>#<<, >>|<, >|<< infixr 2 >>-<, >-<< infixr 1 >^<, >>^<< -- ------------------------------------------------------------------- -- PP instances for often used simple data types --------------------- instance PP Int where pp = text . show instance PP Float where pp = text . show -- ------------------------------------------------------------------- -- Derived from single and multiple ---------------------------------- (>^<), (>#<) :: (PP a, PP b) => a -> b -> PP_Doc a >^< b = join (a >//< b) l >#< r = l >|< " " >|< r pp_es string = if null string then empty else pp string wide_text t s | ls > t = text s | otherwise = text . (if t >= 0 then take t else take 0) $ (s ++ spaces) where ls = length s spaces = repeat ' ' hlist, vlist, hlist_sp :: PP a => [a] -> PP_Doc vlist = foldr (>-<) empty hlist = foldr (>|<) empty hlist_sp = foldr (>#<) empty list_h1 :: [PP_Doc] -> [PP_Doc] list_h1 = map element_h1 hlist_h1 = foldr1 (>|<) . list_h1 (>>^<<), (>>#<<) :: PP_Exp -> PP_Exp -> PP_Exp a >>^<< b = ejoin (a >>//<< b) l >>#<< r = l >>|<< (" " >|<< r) (>|<<), (>-<<) :: PP a => a -> PP_Exp -> PP_Exp l >|<< r = c2e l >>|<< r u >-<< l = c2e u >>-<< l (>>|<), (>>-<) :: PP a => PP_Exp -> a -> PP_Exp l >>|< r = l >>|<< c2e r u >>-< l = u >>-<< c2e l -- ------------------------------------------------------------------- -- Displaying the result --------------------------------------------- vdisp :: Int -> [PP_Doc] -> ShowS vdisp pw = foldr (\f fs -> disp f pw . ("\n"++) . fs) id -- ------------------------------------------------------------------- -- Printing brackets ------------------------------------------------- pp_wrap :: PP a => a -> a -> PP_Doc -> PP_Doc pp_wrap op cl p = op >|< (p >|< cl) pp_quotes = pp_wrap '`' '\'' pp_doubleQuotes = pp_wrap '"' '"' pp_parens = pp_wrap '(' ')' pp_brackets = pp_wrap '[' ']' pp_braces = pp_wrap '{' '}' -- ------------------------------------------------------------------- -- Printing structures -- hv: display a list of elements either horizontally or vertically, -- 2 possible layouts: horizonal or vertical hv :: PP a => [a] -> PP_Doc hv = join . foldr onehv (empty >//< empty) . map pp where onehv p ps = eelement_h1 par >>|<< fpar >>//<< par >>-<< spar >>$< [p, ps] -- hv_sp: same as hv but inserts spaces between the elements -- 2 possible layouts: horizonal or vertical hv_sp :: PP a => [a] -> PP_Doc hv_sp l | null l = empty | otherwise = lhv_sp . map pp $ l lhv_sp fs@(f:fss) = hs >>^<< vs >>$< fs where (hs, vs) = foldr paralg (par, par) fss paralg = \_ (nhs,nvs) -> (eelement_h1 par >>#<< nhs, par >>-<< nvs) -- pp_block: printing of block structures with open, close and separator -- keywords -- 2 possible layouts: horizonal or vertical --pp_block :: String -> String -> String -> [PP_Doc] -> PP_Doc pp_block okw ckw sep fs | null fs = hv [open, close] | otherwise = join ( eelement_h1 par >>|<< fpar >>//<< par >>-<< spar >>$< [open >|< (indent (startcolumn-lk) . head $ fs), hvopts] ) where lk = length okw lsep = length sep startcolumn = (lk `max` lsep) hvopts = foldr hvoptalg dclose (tail fs) hvoptalg p ps = ( par >>|<< eelement_h1 par >>|<< fpar >>//<< par >>|<< eindent (startcolumn - lsep) par >>-<< spar ) >>$< [pp_es sep, p, ps] dclose = eindent (startcolumn-lk) par >>//<< par >>$< [close] open = pp_es okw close = pp_es ckw -- pp_ite: printing an if-then-else-fi statement -- three possible layouts: horizonal, vertical or mixed --pp_ite :: (PP a, PP b, PP c, PP d) -- => a -> b -> c -> d -> PP_Doc -> PP_Doc -> PP_Doc -> PP_Doc pp_ite kw_if kw_then kw_else kw_fi c t e = ( eelement_h1 ( par >>|<< par >>|<< par >>|<< par ) >>^<< ( ( ( par >>|<< par >>^<< par >>-<< par ) >>$<< [par, par >>-<< par] ) >>-<< par ) ) >>$< [ kw_if >|< c , kw_then >|< t , kw_else >|< e , pp kw_fi ] -- pp_slist: printing a list of elements in a "mini page", needs open, close and -- separator keywords and a "mini page" width -- one possible layout: depends on the page width given, when it reaches the end -- of the page it continues on the next line -- restrictions: only simple elements allowed (no pp_slists or flexible layouts -- in the list [PP_Doc]) pp_slist :: Int -> String -> String -> String -> [PP_Doc] -> PP_Doc pp_slist pw ol cl sep fl | null fl = hv [open, close] | otherwise = eelement_h1 (par >>|<< par) >>^<< (par >>-<< par) >>$< [nes, close] where nes = fillblock pw (open: ne: map (pp_es sep >|<) (tail fl)) ne = (replicate (if ws == 0 then 0 else ws - 1) ' ') >|< (head fl) ws = length sep open = pp_es ol close = pp_es cl -- pp_list: printing a list of elements in a "mini page", needs open, close and -- separator keywords and a "mini page" width -- one possible layout: depends on the page width given, when it reaches the end -- of the page it continues on the next line pp_list :: Int -> String -> String -> String -> [PP_Doc] -> PP_Doc pp_list pw ol cl _ [] = pp_es (ol ++ cl) pp_list pw ol cl sep (f:fs) = fillblock pw (pp ol: (pp f): (map (pp_es sep >|<) fs) ++ [ pp cl ]) -- pp_parens_list: idem pp_list, with parenthesis and comma separator pp_parens_list :: Int -> [PP_Doc] -> PP_Doc pp_parens_list mpw = pp_list mpw "(" ")" ", "