summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Blocks.hs
diff options
context:
space:
mode:
authordr@jones.dk <dr@jones.dk>2011-02-04 00:01:35 +0100
committerdr@jones.dk <dr@jones.dk>2011-02-04 00:01:35 +0100
commit91179df4907bec919e0884019da785be1ceb01b3 (patch)
tree2a6655fb4ec4655c554ea17ad074859d707b7709 /src/Text/Pandoc/Blocks.hs
parent1f6b4aee268fefc72c84bd305b10d4f9103901eb (diff)
Imported Upstream version 1.8.0.1
Diffstat (limited to 'src/Text/Pandoc/Blocks.hs')
-rw-r--r--src/Text/Pandoc/Blocks.hs146
1 files changed, 0 insertions, 146 deletions
diff --git a/src/Text/Pandoc/Blocks.hs b/src/Text/Pandoc/Blocks.hs
deleted file mode 100644
index 122931773..000000000
--- a/src/Text/Pandoc/Blocks.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-{-
-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 _ [] = []
-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 linelen = length line
- in if linelen <= width
- then line ++ replicate (width - linelen) ' '
- 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 :: Char -> Bool
-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
-