1 module Pretty(text, separate, cseparate, nest, pretty, (~.), (^.), IText(..), Context(..)) where
6 type IText = Context -> [String]
7 type Context = (Bool,Int,Int,Int)
8 -- Bool laying out in vertical context
9 -- Int character left on the line before margin is reached
10 -- Int maximum preferred number of significant characters on a line
11 -- Int number of characters on last line, excluding leading blanks
13 text :: String -> IText
14 text s (v,w,m,m') = [s]
16 getContext t (v,w,m,m') =
19 sig = if length t == 1
21 else length (dropWhile (==' ') tn)
22 in (False,w-indent,m,sig)
24 (~.) :: IText -> IText -> IText
25 d1 ~. d2 = \ c@(v,w,m,m') ->
26 let t = d1 (False,w,m,m')
27 cx@(_,w',_,_) = getContext t c
33 map (space indent++) ls
35 space :: Int -> String
36 space n = [' ' | i<-[1..n]]
38 (^.) :: IText -> IText -> IText
39 d1 ^. d2 = \ (v,w,m,m') -> d1 (True,w,m,m') ++ d2 (True,w,m,0)
41 separate :: [IText] -> IText
43 separate ds c@(v,w,m,m') =
44 let hor = joinText (text " ") ds
47 in if lengthLe t 1 && lengthLe (head t) ((w `min` (m-m')) `max` 0)
51 -- Try to put as many things as possible on each line.
53 cseparate :: [IText] -> IText
55 cseparate ds c@(v,w,m,m') =
57 let t = joinText (text " ") (a ++ [d]) c
58 in if lengthLe t 1 then
59 if lengthLe (head t) ((w `min` (m-m')) `max` 0) then
62 csep (r++adda a) [d] ds
64 csep (r ++ adda a ++ [d]) [] ds
65 csep r a [] = r ++ adda a
67 adda a = [joinText (text " ") a]
68 in foldr1 (^.) (csep [] [] ds) c
70 joinText t ds = foldr1 (\d1 d2 -> d1 ~. t ~. d2) ds
72 -- Check if the length of a list is less than n, without evaluating it completely.
73 lengthLe :: [a] -> Int -> Bool
74 lengthLe [] n = n >= 0
75 lengthLe (_:_) 0 = False
76 lengthLe (_:xs) n = lengthLe xs (n-1)
78 nest :: Int -> IText -> IText
81 map (space n++) (d (v,w-n,m,if m'==0 then 0 else m'+n))
85 pretty :: Int->Int->IText->String
86 pretty w m d = unlines (d (False,w,m,0))