git.iko.soy/typeable/pandoc
on master help sign in
Improvements/bug fixes to Text.Pandoc.Blocks

library. git-svn-id: https://pandoc.googlecode.com/svn/trunk@622 788f1e2b-df1e-0410-8736-df70ead52e1b

commit8d776e1e421321fba7ea5dc21ff4f861ccf0afe2 authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> dateWed 4 Jul 2007, 22:21 (19 years ago) parent948ea86
1 file changed+32−3
src/Text/Pandoc/Blocks.hs+32−3
src/Text/Pandoc/Blocks.hs+32−3
@@ -1,11 +1,15 @@
1−module Text.Blocks
1+module Text.Pandoc.Blocks
22 (
3+ TextBlock (..),
34 docToBlock,
45 blockToDoc,
56 widthOfBlock,
67 heightOfBlock,
78 hcatBlocks,
8− hsepBlocks
9+ hsepBlocks,
10+ centerAlignBlock,
11+ leftAlignBlock,
12+ rightAlignBlock
913 )
1014where
1115
@@ -32,7 +36,7 @@ blockToDoc :: TextBlock -> Doc
3236blockToDoc (TextBlock _ _ lns) =
3337 if null lns
3438 then empty
35− else text $ unlines (init lns) ++ last lns -- to avoid trailing \n
39+ else vcat $ map text lns
3640
3741widthOfBlock :: TextBlock -> Int
3842widthOfBlock (TextBlock width _ _) = width
@@ -61,3 +65,28 @@ hcatBlocks ((TextBlock width1 height1 lns1):xs) =
6165
6266hsepBlocks = hcatBlocks . (intersperse (TextBlock 1 1 [" "]))
6367
68+isWhitespace x = x `elem` " \t"
69+
70+leftAlignBlock :: TextBlock -> TextBlock
71+leftAlignBlock (TextBlock width height lns) =
72+ TextBlock width height $
73+ map (dropWhile isWhitespace) lns
74+
75+rightAlignBlock :: TextBlock -> TextBlock
76+rightAlignBlock (TextBlock width height lns) =
77+ let rightAlignLine ln =
78+ let (spaces, rest) = span isWhitespace $ reverse $ hPad width ln
79+ in reverse (rest ++ spaces)
80+ in TextBlock width height $ map rightAlignLine lns
81+
82+centerAlignBlock :: TextBlock -> TextBlock
83+centerAlignBlock (TextBlock width height lns) =
84+ let centerAlignLine ln =
85+ let ln' = hPad width ln
86+ (startSpaces, rest) = span isWhitespace ln'
87+ endSpaces = takeWhile isWhitespace (reverse ln')
88+ numSpaces = length (startSpaces ++ endSpaces)
89+ startSpaces' = replicate (quot numSpaces 2) ' '
90+ in startSpaces' ++ rest
91+ in TextBlock width height $ map centerAlignLine lns
92+