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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
module Pretty(text, separate, cseparate, nest, pretty, (~.), (^.), IText(..), Context(..)) where
infixr 8 ~.
infixr 8 ^.
type IText = Context -> [String]
type Context = (Bool,Int,Int,Int)
-- Bool laying out in vertical context
-- Int character left on the line before margin is reached
-- Int maximum preferred number of significant characters on a line
-- Int number of characters on last line, excluding leading blanks
text :: String -> IText
text s (v,w,m,m') = [s]
getContext t (v,w,m,m') =
let tn = last t
indent = length tn
sig = if length t == 1
then m' + indent
else length (dropWhile (==' ') tn)
in (False,w-indent,m,sig)
(~.) :: IText -> IText -> IText
d1 ~. d2 = \ c@(v,w,m,m') ->
let t = d1 (False,w,m,m')
cx@(_,w',_,_) = getContext t c
indent = w-w'
tn = last t
(l:ls) = d2 cx
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 c@(v,w,m,m') =
let hor = joinText (text " ") ds
ver = foldr1 (^.) ds
t = hor c
in if lengthLe t 1 && lengthLe (head t) ((w `min` (m-m')) `max` 0)
then t
else ver c
-- Try to put as many things as possible on each line.
-- Inefficient!
cseparate :: [IText] -> IText
cseparate [] _ = [""]
cseparate ds c@(v,w,m,m') =
let csep r a (d:ds) =
let t = joinText (text " ") (a ++ [d]) c
in if lengthLe t 1 then
if lengthLe (head t) ((w `min` (m-m')) `max` 0) then
csep r (a ++ [d]) ds
else
csep (r++adda a) [d] ds
else
csep (r ++ adda a ++ [d]) [] ds
csep r a [] = r ++ adda a
adda [] = []
adda a = [joinText (text " ") a]
in foldr1 (^.) (csep [] [] ds) c
joinText t ds = foldr1 (\d1 d2 -> d1 ~. t ~. d2) ds
-- Check if the length of a list is less than n, without evaluating it completely.
lengthLe :: [a] -> Int -> Bool
lengthLe [] n = n >= 0
lengthLe (_:_) 0 = False
lengthLe (_:xs) n = lengthLe xs (n-1)
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 = unlines (d (False,w,m,0))
|
