Make default output less verbose (source/object paths)
[ghc.git] / utils / mkUserGuidePart / Table.hs
1 module Table where
2
3 import Data.Char
4 import Data.List
5 import Data.Maybe (isJust, fromMaybe)
6 import qualified DList
7
8 type Row = [String]
9
10 type ColWidth = Int
11
12 type WrappedString = [String]
13
14 -- | Wrap a string to lines of at most the given length on whitespace
15 -- if possible.
16 wrapAt :: Int -> String -> WrappedString
17 wrapAt width = wrapLine
18 where
19 wrapLine :: String -> WrappedString
20 wrapLine s =
21 go width mempty (take width s : wrapLine (drop width s)) s
22
23 go :: Int -- ^ remaining width
24 -> DList.DList Char -- ^ accumulator
25 -> WrappedString -- ^ last good wrapping
26 -> String -- ^ remaining string
27 -> WrappedString
28 go 0 _ back _ = back
29 go n accum _ (c:rest)
30 | breakable c = go (n-1) accum'
31 (DList.toList accum' : wrapLine rest) rest
32 where accum' = accum `DList.snoc` c
33 go n accum back (c:rest) = go (n-1) (accum `DList.snoc` c) back rest
34 go _ accum _ [] = [DList.toList accum]
35
36 breakable = isSpace
37
38 transpose' :: [[a]] -> [[Maybe a]]
39 transpose' = goRow
40 where
41 peel :: [a] -> (Maybe a, [a])
42 peel (x:xs) = (Just x, xs)
43 peel [] = (Nothing, [])
44
45 goRow xs =
46 case unzip $ map peel xs of
47 (xs', ys)
48 | any isJust xs' -> xs' : goRow ys
49 | otherwise -> []
50
51 table :: [ColWidth] -> Row -> [Row] -> String
52 table widths hdr rows = unlines $
53 [rule '-'] ++
54 [formatRow hdr] ++
55 [rule '='] ++
56 intersperse (rule '-') (map formatRow rows) ++
57 [rule '-']
58 where
59 formatRow :: Row -> String
60 formatRow cols =
61 intercalate "\n"
62 $ map (rawRow . map (fromMaybe ""))
63 $ transpose'
64 $ zipWith wrapAt (map (subtract 4) widths) cols
65
66 rawRow :: Row -> String
67 rawRow cols = "| " ++ intercalate " | " (zipWith padTo widths cols) ++ " |"
68 padTo width content = take width $ content ++ repeat ' '
69
70 rule :: Char -> String
71 rule lineChar =
72 ['+',lineChar]
73 ++intercalate [lineChar,'+',lineChar]
74 (map (\n -> replicate n lineChar) widths)
75 ++[lineChar,'+']