uulib-0.9.5: src/UU/Pretty/Ext.hs
-- $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 "(" ")" ", "