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)))