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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{-
Copyright (C) 2007 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Text.Pandoc.Blocks
Copyright : Copyright (C) 2007 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Functions for the manipulation of fixed-width blocks of text.
These are used in the construction of plain-text tables.
-}
module Text.Pandoc.Blocks
(
TextBlock (..),
docToBlock,
blockToDoc,
widthOfBlock,
heightOfBlock,
hcatBlocks,
hsepBlocks,
centerAlignBlock,
leftAlignBlock,
rightAlignBlock
)
where
import Text.PrettyPrint
import Data.List ( intersperse )
-- | A fixed-width block of text. Parameters are width of block,
-- height of block, and list of lines.
data TextBlock = TextBlock Int Int [String]
instance Show TextBlock where
show x = show $ blockToDoc x
-- | Break lines in a list of lines so that none are greater than
-- a given width.
breakLines :: Int -- ^ Maximum length of lines.
-> [String] -- ^ List of lines.
-> [String]
breakLines width [] = []
breakLines width (l:ls) =
if length l > width
then (take width l):(breakLines width ((drop width l):ls))
else l:(breakLines width ls)
-- | Convert a @Doc@ element into a @TextBlock@ with a specified width.
docToBlock :: Int -- ^ Width of text block.
-> Doc -- ^ @Doc@ to convert.
-> TextBlock
docToBlock width doc =
let rendered = renderStyle (style {lineLength = width,
ribbonsPerLine = 1}) doc
lns = breakLines width $ lines rendered
in TextBlock width (length lns) lns
-- | Convert a @TextBlock@ to a @Doc@ element.
blockToDoc :: TextBlock -> Doc
blockToDoc (TextBlock _ _ lns) =
if null lns
then empty
else vcat $ map text lns
-- | Returns width of a @TextBlock@ (number of columns).
widthOfBlock :: TextBlock -> Int
widthOfBlock (TextBlock width _ _) = width
-- | Returns height of a @TextBlock@ (number of rows).
heightOfBlock :: TextBlock -> Int
heightOfBlock (TextBlock _ height _) = height
-- | Pads a string out to a given width using spaces.
hPad :: Int -- ^ Desired width.
-> String -- ^ String to pad.
-> String
hPad width line =
let lineLength = length line
in if lineLength <= width
then line ++ replicate (width - lineLength) ' '
else take width line
-- | Concatenates a list of @TextBlock@s into a new @TextBlock@ in
-- which they appear side by side.
hcatBlocks :: [TextBlock] -> TextBlock
hcatBlocks [] = TextBlock 0 0 []
hcatBlocks [x] = x -- This is not redundant! We don't want last item hPad'd.
hcatBlocks ((TextBlock width1 height1 lns1):xs) =
let (TextBlock width2 height2 lns2) = hcatBlocks xs
height = max height1 height2
width = width1 + width2
lns1' = map (hPad width1) $ lns1 ++ replicate (height - height1) ""
lns2' = lns2 ++ replicate (height - height2) ""
lns = zipWith (++) lns1' lns2'
in TextBlock width height lns
-- | Like @hcatBlocks@, but inserts space between the @TextBlock@s.
hsepBlocks :: [TextBlock] -> TextBlock
hsepBlocks = hcatBlocks . (intersperse (TextBlock 1 1 [" "]))
isWhitespace x = x `elem` " \t"
-- | Left-aligns the contents of a @TextBlock@ within the block.
leftAlignBlock :: TextBlock -> TextBlock
leftAlignBlock (TextBlock width height lns) =
TextBlock width height $ map (dropWhile isWhitespace) lns
-- | Right-aligns the contents of a @TextBlock@ within the block.
rightAlignBlock :: TextBlock -> TextBlock
rightAlignBlock (TextBlock width height lns) =
let rightAlignLine ln =
let (spaces, rest) = span isWhitespace $ reverse $ hPad width ln
in reverse (rest ++ spaces)
in TextBlock width height $ map rightAlignLine lns
-- | Centers the contents of a @TextBlock@ within the block.
centerAlignBlock :: TextBlock -> TextBlock
centerAlignBlock (TextBlock width height lns) =
let centerAlignLine ln =
let ln' = hPad width ln
(startSpaces, rest) = span isWhitespace ln'
endSpaces = takeWhile isWhitespace (reverse ln')
numSpaces = length (startSpaces ++ endSpaces)
startSpaces' = replicate (quot numSpaces 2) ' '
in startSpaces' ++ rest
in TextBlock width height $ map centerAlignLine lns
|
