--  $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 "(" ")" ", "