diff options
author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
---|---|---|
committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /progs/lib/hbc/Pretty.hs |
Import to github.
Diffstat (limited to 'progs/lib/hbc/Pretty.hs')
-rw-r--r-- | progs/lib/hbc/Pretty.hs | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/progs/lib/hbc/Pretty.hs b/progs/lib/hbc/Pretty.hs new file mode 100644 index 0000000..ad63dbe --- /dev/null +++ b/progs/lib/hbc/Pretty.hs @@ -0,0 +1,50 @@ +module Pretty(text, separate, nest, pretty, (~.), (^.), IText(..), Context(..)) where +infixr 8 ~. +infixr 8 ^. + +type IText = Context -> [String] +type Context = (Bool,Int,Int,Int) + +text :: String -> IText +text s (v,w,m,m') = [s] + +(~.) :: IText -> IText -> IText +(~.) d1 d2 (v,w,m,m') = + let t = d1 (False,w,m,m') + tn = last t + indent = length tn + sig = if length t == 1 + then m' + indent + else length (dropWhile (==' ') tn) + (l:ls) = d2 (False,w-indent,m,sig) + in init t ++ + [tn ++ l] ++ + map (space indent++) ls + +space :: Int -> String +space n = [' ' | i<-[1..n]] + +(^.) :: IText -> IText -> IText +(^.) d1 d2 (v,w,m,m') = d1 (True,w,m,m') ++ d2 (True,w,m,0) + +separate :: [IText] -> IText +separate [] _ = [""] +separate ds (v,w,m,m') = + let hor = foldr1 (\d1 d2 -> d1 ~. text " " ~. d2) ds + ver = foldr1 (^.) ds + t = hor (v,w,m,m') + in if fits 1 t && fits (w `min` m-m') (head t) + then t + else ver (v,w,m,m') + +fits n xs = length xs <= n `max` 0 --null (drop n xs) + +nest :: Int -> IText -> IText +nest n d (v,w,m,m') = + if v then + map (space n++) (d (v,w-n,m,if m'==0 then 0 else m'+n)) + else + d (v,w,m,m') + +pretty :: Int->Int->IText->String +pretty w m d = concat (map (++"\n") (d (False,w,m,0))) |