1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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)))
|