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
|
{-
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 (transpose, 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
-- | 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 = lines rendered
chop [] = []
chop (l:ls) = if length l > width
then (take width l):(chop ((drop width l):ls))
else l:(chop ls)
lns' = chop lns
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 ((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 = 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
|
