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
|
module Table where
import Data.Char
import Data.List
import Data.Maybe (isJust, fromMaybe)
import qualified DList
type Row = [String]
type ColWidth = Int
type WrappedString = [String]
-- | Wrap a string to lines of at most the given length on whitespace
-- if possible.
wrapAt :: Int -> String -> WrappedString
wrapAt width = wrapLine
where
wrapLine :: String -> WrappedString
wrapLine s =
go width mempty (take width s : wrapLine (drop width s)) s
go :: Int -- ^ remaining width
-> DList.DList Char -- ^ accumulator
-> WrappedString -- ^ last good wrapping
-> String -- ^ remaining string
-> WrappedString
go 0 _ back _ = back
go n accum _ (c:rest)
| breakable c = go (n-1) accum'
(DList.toList accum' : wrapLine rest) rest
where accum' = accum `DList.snoc` c
go n accum back (c:rest) = go (n-1) (accum `DList.snoc` c) back rest
go _ accum _ [] = [DList.toList accum]
breakable = isSpace
transpose' :: [[a]] -> [[Maybe a]]
transpose' = goRow
where
peel :: [a] -> (Maybe a, [a])
peel (x:xs) = (Just x, xs)
peel [] = (Nothing, [])
goRow xs =
case unzip $ map peel xs of
(xs', ys)
| any isJust xs' -> xs' : goRow ys
| otherwise -> []
table :: [ColWidth] -> Row -> [Row] -> String
table widths hdr rows = unlines $
[rule '-'] ++
[formatRow hdr] ++
[rule '='] ++
intersperse (rule '-') (map formatRow rows) ++
[rule '-']
where
formatRow :: Row -> String
formatRow cols =
intercalate "\n"
$ map (rawRow . map (fromMaybe ""))
$ transpose'
$ zipWith wrapAt (map (subtract 4) widths) cols
rawRow :: Row -> String
rawRow cols = "| " ++ intercalate " | " (zipWith padTo widths cols) ++ " |"
padTo width content = take width $ content ++ repeat ' '
rule :: Char -> String
rule lineChar =
['+',lineChar]
++intercalate [lineChar,'+',lineChar]
(map (\n -> replicate n lineChar) widths)
++[lineChar,'+']
|
