Use Data.List's 'intercalate' instead of custom 'joinWithSep'.

+ Removed joinWithSep definition from Text.Pandoc.Shared.
+ Replaced joinWithSep with intercalate
+ Depend on base >= 3, since in base < 3 intercalate is not included.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1428 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher 2008-09-08 06:36:28 +00:00
parent 2e893b43c4
commit 000b89c718
15 changed files with 54 additions and 65 deletions

13
Main.hs
View file

@ -32,7 +32,7 @@ writers.
module Main where
import Text.Pandoc
import Text.Pandoc.ODT
import Text.Pandoc.Shared ( joinWithSep, HTMLMathMethod (..) )
import Text.Pandoc.Shared ( HTMLMathMethod (..) )
import Text.Pandoc.Highlighting ( languages )
import System.Environment ( getArgs, getProgName, getEnvironment )
import System.Exit ( exitWith, ExitCode (..) )
@ -40,6 +40,7 @@ import System.FilePath ( takeExtension, takeDirectory )
import System.Console.GetOpt
import Data.Maybe ( fromMaybe )
import Data.Char ( toLower )
import Data.List ( intercalate )
import Prelude hiding ( putStrLn, writeFile, readFile, getContents )
import System.IO ( stdout, stderr )
import System.IO.UTF8
@ -188,13 +189,13 @@ options =
(ReqArg
(\arg opt -> return opt { optReader = map toLower arg })
"FORMAT")
"" -- ("(" ++ (joinWithSep ", " $ map fst readers) ++ ")")
"" -- ("(" ++ (intercalate ", " $ map fst readers) ++ ")")
, Option "tw" ["to","write"]
(ReqArg
(\arg opt -> return opt { optWriter = map toLower arg })
"FORMAT")
"" -- ("(" ++ (joinWithSep ", " $ map fst writers) ++ ")")
"" -- ("(" ++ (intercalate ", " $ map fst writers) ++ ")")
, Option "s" ["standalone"]
(NoArg
@ -389,8 +390,8 @@ options =
usageMessage :: String -> [OptDescr (Opt -> IO Opt)] -> String
usageMessage programName opts = usageInfo
(programName ++ " [OPTIONS] [FILES]" ++ "\nInput formats: " ++
(joinWithSep ", " $ map fst readers) ++ "\nOutput formats: " ++
(joinWithSep ", " $ map fst writers) ++ "\nOptions:")
(intercalate ", " $ map fst readers) ++ "\nOutput formats: " ++
(intercalate ", " $ map fst writers) ++ "\nOptions:")
opts
-- Determine default reader based on source file extensions
@ -599,7 +600,7 @@ main = do
then putStrLn
else writeFile outputFile . (++ "\n")
fmap (reader startParserState . tabFilter tabStop . joinWithSep "\n")
fmap (reader startParserState . tabFilter tabStop . intercalate "\n")
(readSources sources) >>=
#ifdef _CITEPROC
processBiblio cslFile refs >>=

View file

@ -46,7 +46,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
import Data.Maybe ( fromMaybe )
import Data.List ( takeWhile, dropWhile, isPrefixOf, isSuffixOf )
import Data.List ( takeWhile, dropWhile, isPrefixOf, isSuffixOf, intercalate )
import Data.Char ( toLower, isAlphaNum )
import Network.URI ( parseURIReference, URI (..) )
@ -534,7 +534,7 @@ definitionListItem :: GenParser Char ParserState ([Inline], [Block])
definitionListItem = try $ do
terms <- sepEndBy1 (inlinesIn "dt") spaces
defs <- sepEndBy1 (blocksIn "dd") spaces
let term = joinWithSep [LineBreak] terms
let term = intercalate [LineBreak] terms
return (term, concat defs)
--
@ -580,7 +580,7 @@ code = try $ do
-- remove internal line breaks, leading and trailing space,
-- and decode character references
return $ Code $ decodeCharacterReferences $ removeLeadingTrailingSpace $
joinWithSep " " $ lines result
intercalate " " $ lines result
rawHtmlInline :: GenParser Char ParserState Inline
rawHtmlInline = do

View file

@ -32,7 +32,7 @@ module Text.Pandoc.Readers.Markdown (
readMarkdown
) where
import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy, findIndex )
import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy, findIndex, intercalate )
import Data.Ord ( comparing )
import Data.Char ( isAlphaNum, isAlpha, isLower, isDigit )
import Data.Maybe
@ -234,7 +234,7 @@ noteBlock = try $ do
optional blanklines
endPos <- getPosition
-- parse the extracted text, which may contain various block elements:
contents <- parseFromString parseBlocks $ (joinWithSep "\n" raw) ++ "\n\n"
contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
let newnote = (ref, contents)
st <- getState
let oldnotes = stateNotes st
@ -381,7 +381,7 @@ codeBlockDelimited = try $ do
(size, attr) <- codeBlockDelimiter Nothing
contents <- manyTill anyLine (codeBlockDelimiter (Just size))
blanklines
return $ CodeBlock attr $ joinWithSep "\n" contents
return $ CodeBlock attr $ intercalate "\n" contents
codeBlockIndented :: GenParser Char ParserState Block
codeBlockIndented = do
@ -414,7 +414,7 @@ blockQuote :: GenParser Char ParserState Block
blockQuote = do
raw <- emailBlockQuote
-- parse the extracted block, which may contain various block elements:
contents <- parseFromString parseBlocks $ (joinWithSep "\n" raw) ++ "\n\n"
contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
return $ BlockQuote contents
--
@ -757,7 +757,7 @@ multilineTableHeader = try $ do
let rawHeadsList = transpose $ map
(\ln -> tail $ splitByIndices (init indices) ln)
rawContent
let rawHeads = map (joinWithSep " ") rawHeadsList
let rawHeads = map (intercalate " ") rawHeadsList
let aligns = zipWith alignType rawHeadsList lengths
return ((map removeLeadingTrailingSpace rawHeads), aligns, indices)
@ -884,7 +884,7 @@ mathInline = try $ do
words' <- sepBy1 mathWord (many1 (spaceChar <|> (newline >>~ notFollowedBy' blankline)))
char '$'
notFollowedBy digit
return $ joinWithSep " " words'
return $ intercalate " " words'
emph :: GenParser Char ParserState Inline
emph = ((enclosed (char '*') (notFollowedBy' strong >> char '*') inline) <|>

View file

@ -33,7 +33,7 @@ module Text.Pandoc.Readers.RST (
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.ParserCombinators.Parsec
import Data.List ( findIndex, delete )
import Data.List ( findIndex, delete, intercalate )
-- | Parse reStructuredText string and return Pandoc document.
readRST :: ParserState -> String -> Pandoc
@ -144,7 +144,7 @@ fieldListItem indent = try $ do
first <- manyTill anyChar newline
rest <- option "" $ try $ lookAhead (string indent >> oneOf " \t") >>
indentedBlock
return (name, joinWithSep " " (first:(lines rest)))
return (name, intercalate " " (first:(lines rest)))
fieldList :: GenParser Char ParserState Block
fieldList = try $ do
@ -583,7 +583,7 @@ code :: GenParser Char ParserState Inline
code = try $ do
string "``"
result <- manyTill anyChar (try (string "``"))
return $ Code $ removeLeadingTrailingSpace $ joinWithSep " " $ lines result
return $ Code $ removeLeadingTrailingSpace $ intercalate " " $ lines result
emph :: GenParser Char ParserState Inline
emph = enclosed (char '*') (char '*') inline >>=

View file

@ -33,7 +33,6 @@ module Text.Pandoc.Shared (
splitBy,
splitByIndices,
substitute,
joinWithSep,
-- * Text processing
backslashEscapes,
escapeStringUsing,
@ -110,7 +109,7 @@ import Text.PrettyPrint.HughesPJ ( Doc, fsep, ($$), (<>), empty, isEmpty, text )
import qualified Text.PrettyPrint.HughesPJ as PP
import Text.Pandoc.CharacterReferences ( characterReference )
import Data.Char ( toLower, toUpper, ord, isLower, isUpper )
import Data.List ( find, isPrefixOf )
import Data.List ( find, isPrefixOf, intercalate )
import Control.Monad ( join )
import Network.URI ( parseURI, URI (..), isAllowedInURI )
import System.Directory
@ -145,13 +144,6 @@ substitute target replacement lst =
then replacement ++ (substitute target replacement $ drop (length target) lst)
else (head lst):(substitute target replacement $ tail lst)
-- | Joins a list of lists, separated by another list.
joinWithSep :: [a] -- ^ List to use as separator
-> [[a]] -- ^ Lists to join
-> [a]
joinWithSep _ [] = []
joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
--
-- Text processing
--
@ -441,7 +433,7 @@ domain :: GenParser Char st [Char]
domain = do
first <- many1 domainChar
dom <- many1 $ try (char '.' >> many1 domainChar )
return $ joinWithSep "." (first:dom)
return $ intercalate "." (first:dom)
-- | Parses an email address; returns string.
emailAddress :: GenParser Char st [Char]
@ -732,7 +724,7 @@ indentBy num first str =
let (firstLine:restLines) = lines str
firstLineIndent = num + first
in (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++
(joinWithSep "\n" $ map ((replicate num ' ') ++ ) restLines)
(intercalate "\n" $ map ((replicate num ' ') ++ ) restLines)
-- | Prettyprint list of Pandoc blocks elements.
prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
@ -740,7 +732,7 @@ prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
-> String
prettyBlockList indent [] = indentBy indent 0 "[]"
prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
(joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
(intercalate "\n, " (map prettyBlock blocks)) ++ " ]"
-- | Prettyprint Pandoc block element.
prettyBlock :: Block -> String
@ -748,20 +740,20 @@ prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
(prettyBlockList 2 blocks)
prettyBlock (OrderedList attribs blockLists) =
"OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
(joinWithSep ", " $ map (\blocks -> prettyBlockList 2 blocks)
(intercalate ", " $ map (\blocks -> prettyBlockList 2 blocks)
blockLists)) ++ " ]"
prettyBlock (BulletList blockLists) = "BulletList\n" ++
indentBy 2 0 ("[ " ++ (joinWithSep ", "
indentBy 2 0 ("[ " ++ (intercalate ", "
(map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
prettyBlock (DefinitionList blockLists) = "DefinitionList\n" ++
indentBy 2 0 ("[" ++ (joinWithSep ",\n"
indentBy 2 0 ("[" ++ (intercalate ",\n"
(map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++
indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]"
prettyBlock (Table caption aligns widths header rows) =
"Table " ++ show caption ++ " " ++ show aligns ++ " " ++
show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
(joinWithSep ",\n" (map prettyRow rows)) ++ " ]"
where prettyRow cols = indentBy 2 0 ("[ " ++ (joinWithSep ", "
(intercalate ",\n" (map prettyRow rows)) ++ " ]"
where prettyRow cols = indentBy 2 0 ("[ " ++ (intercalate ", "
(map (\blocks -> prettyBlockList 2 blocks)
cols))) ++ " ]"
prettyBlock block = show block

View file

@ -31,7 +31,7 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Printf ( printf )
import Data.List ( isSuffixOf )
import Data.List ( isSuffixOf, intercalate )
import Control.Monad.State
import Text.PrettyPrint.HughesPJ hiding ( Str )
@ -87,7 +87,7 @@ contextHeader options (Meta title authors date) = do
then ""
else if length authors == 1
then stringToConTeXt $ head authors
else stringToConTeXt $ (joinWithSep ", " $
else stringToConTeXt $ (intercalate ", " $
init authors) ++ " & " ++ last authors
let datetext = if date == ""
then ""
@ -168,7 +168,7 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do
let specs2Items = filter (not . null) [start', delim', width'']
let specs2 = if null specs2Items
then ""
else "[" ++ joinWithSep "," specs2Items ++ "]"
else "[" ++ intercalate "," specs2Items ++ "]"
let style'' = case style' of
DefaultStyle -> orderedListStyles !! level
Decimal -> "[n]"

View file

@ -32,7 +32,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Data.List ( isPrefixOf, drop )
import Data.List ( isPrefixOf, drop, intercalate )
import Text.PrettyPrint.HughesPJ hiding ( Str )
-- | Convert list of authors to a docbook <author> section
@ -50,7 +50,7 @@ authorToDocbook name = inTagsIndented "author" $
(firstname, lastname) = case lengthname of
0 -> ("","")
1 -> ("", name)
n -> (joinWithSep " " (take (n-1) namewords), last namewords)
n -> (intercalate " " (take (n-1) namewords), last namewords)
in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$
inTagsSimple "surname" (text $ escapeStringForXML lastname)

View file

@ -37,7 +37,7 @@ import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
import Numeric ( showHex )
import Data.Char ( ord, toLower, isAlpha )
import Data.List ( isPrefixOf, intersperse )
import Data.List ( isPrefixOf, intercalate )
import qualified Data.Set as S
import Control.Monad.State
import Text.XHtml.Transitional hiding ( stringToHtml )
@ -252,7 +252,7 @@ inlineListToIdentifier' (x:xs) =
xAsText ++ inlineListToIdentifier' xs
where xAsText = case x of
Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $
concat $ intersperse "-" $ words $ map toLower s
intercalate "-" $ words $ map toLower s
Emph lst -> inlineListToIdentifier' lst
Strikeout lst -> inlineListToIdentifier' lst
Superscript lst -> inlineListToIdentifier' lst

View file

@ -31,7 +31,7 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Printf ( printf )
import Data.List ( (\\), isSuffixOf )
import Data.List ( (\\), isSuffixOf, intercalate )
import Data.Char ( toLower )
import qualified Data.Set as S
import Control.Monad.State
@ -92,7 +92,7 @@ latexHeader options (Meta title authors date) = do
then text "\\VerbatimFootnotes % allows verbatim text in footnotes"
else empty
let authorstext = text $ "\\author{" ++
joinWithSep "\\\\" (map stringToLaTeX authors) ++ "}"
intercalate "\\\\" (map stringToLaTeX authors) ++ "}"
let datetext = if date == ""
then empty
else text $ "\\date{" ++ stringToLaTeX date ++ "}"

View file

@ -32,7 +32,7 @@ module Text.Pandoc.Writers.Man ( writeMan) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Printf ( printf )
import Data.List ( isPrefixOf, drop, nub, intersperse )
import Data.List ( isPrefixOf, drop, nub, intersperse, intercalate )
import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State
@ -77,8 +77,8 @@ metaToMan options (Meta title authors date) = do
doubleQuotes (text date) <+> hsep extras
let foot = case length authors of
0 -> empty
1 -> text ".SH AUTHOR" $$ (text $ joinWithSep ", " authors)
_ -> text ".SH AUTHORS" $$ (text $ joinWithSep ", " authors)
1 -> text ".SH AUTHOR" $$ (text $ intercalate ", " authors)
_ -> text ".SH AUTHORS" $$ (text $ intercalate ", " authors)
return $ if writerStandalone options
then (head', foot)
else (empty, empty)
@ -144,7 +144,7 @@ blockToMan opts (Table caption alignments widths headers rows) =
modify (\(notes, preprocessors) -> (notes, "t":preprocessors))
let iwidths = map (printf "w(%0.2fn)" . (70 *)) widths
-- 78n default width - 8n indent = 70n
let coldescriptions = text $ joinWithSep " "
let coldescriptions = text $ intercalate " "
(zipWith (\align width -> aligncode align ++ width)
alignments iwidths) ++ "."
colheadings <- mapM (blockListToMan opts) headers

View file

@ -34,7 +34,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Blocks
import Text.ParserCombinators.Parsec ( parse, GenParser )
import Data.List ( group, isPrefixOf, drop, find, intersperse )
import Data.List ( group, isPrefixOf, drop, find, intersperse, intercalate )
import Text.PrettyPrint.HughesPJ hiding ( Str )
import Control.Monad.State
@ -119,7 +119,7 @@ titleToMarkdown opts lst = do
authorsToMarkdown :: [String] -> State WriterState Doc
authorsToMarkdown [] = return empty
authorsToMarkdown lst = return $
text "% " <> text (joinWithSep ", " (map escapeString lst))
text "% " <> text (intercalate ", " (map escapeString lst))
dateToMarkdown :: String -> State WriterState Doc
dateToMarkdown [] = return empty

View file

@ -39,6 +39,7 @@ import Control.Applicative ( (<$>) )
import Control.Arrow ( (***), (>>>) )
import Control.Monad.State hiding ( when )
import Data.Char (chr)
import Data.List (intercalate)
-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
@ -171,7 +172,7 @@ authorToOpenDocument name =
(firstname, lastname) = case lengthname of
0 -> ("","")
1 -> ("", name)
n -> (joinWithSep " " (take (n-1) namewords), last namewords)
n -> (intercalate " " (take (n-1) namewords), last namewords)
in inParagraphTagsWithStyle "Author" $
(text $ escapeStringForXML firstname) <+>
(text $ escapeStringForXML lastname)

View file

@ -31,7 +31,7 @@ module Text.Pandoc.Writers.RTF ( writeRTF ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
import Data.List ( isSuffixOf )
import Data.List ( isSuffixOf, intercalate )
import Data.Char ( ord, isDigit )
-- | Convert Pandoc to a string in rich text format.
@ -82,7 +82,7 @@ stringToRTF = handleUnicode . escapeSpecial
-- | Escape things as needed for code block in RTF.
codeStringToRTF :: String -> String
codeStringToRTF str = joinWithSep "\\line\n" $ lines (stringToRTF str)
codeStringToRTF str = intercalate "\\line\n" $ lines (stringToRTF str)
-- | Make a paragraph with first-line indent, block indent, and space after.
rtfParSpaced :: Int -- ^ space after (in twips)
@ -150,7 +150,7 @@ rtfHeader headerText (Meta title authors date) =
"\\b \\fs36 " ++ inlineListToRTF title
authorstext = if null authors
then ""
else rtfPar 0 0 AlignCenter (" " ++ (joinWithSep "\\" $
else rtfPar 0 0 AlignCenter (" " ++ (intercalate "\\" $
map stringToRTF authors))
datetext = if date == ""
then ""

View file

@ -40,12 +40,13 @@ module Text.Pandoc.Writers.S5 (
writeS5String,
insertS5Structure
) where
import Text.Pandoc.Shared ( joinWithSep, WriterOptions )
import Text.Pandoc.Shared ( WriterOptions )
import Text.Pandoc.TH ( contentsOf )
import Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString )
import Text.Pandoc.Definition
import Text.XHtml.Strict
import System.FilePath ( (</>) )
import Data.List ( intercalate )
s5Meta :: String
s5Meta = "<!-- configuration parameters -->\n<meta name=\"defaultView\" content=\"slideshow\" />\n<meta name=\"controlVis\" content=\"hidden\" />\n"
@ -148,7 +149,7 @@ insertS5Structure (Pandoc (Meta title' authors date) blocks) =
let slides = insertSlides True blocks
firstSlide = if not (null title')
then [slideStart, (Header 1 title'),
(Header 3 [Str (joinWithSep ", " authors)]),
(Header 3 [Str (intercalate ", " authors)]),
(Header 4 [Str date]), slideEnd]
else []
newBlocks = (layoutDiv title' date) ++ presentationStart:firstSlide ++

View file

@ -120,9 +120,6 @@ Extra-Source-Files:
Extra-Tmp-Files: man/man1/pandoc.1, man/man1/hsmarkdown.1,
man/man1/html2markdown.1
Flag splitBase
Description: Choose the new, smaller, split-up base package.
Default: True
Flag highlighting
Description: Compile in support for syntax highlighting of code blocks.
Default: False
@ -137,10 +134,9 @@ Flag citeproc
Default: False
Library
if flag(splitBase)
Build-Depends: base >= 3, pretty, containers
else
Build-Depends: base < 3
Build-Depends: base >= 3, pretty, containers, parsec < 3, xhtml, mtl, network,
filepath, process, directory, template-haskell, bytestring,
zip-archive, utf8-string, old-time
if flag(highlighting)
Build-depends: highlighting-kate
cpp-options: -D_HIGHLIGHTING
@ -148,8 +144,6 @@ Library
Build-depends: citeproc-hs
Exposed-Modules: Text.Pandoc.Biblio
cpp-options: -D_CITEPROC
Build-Depends: parsec < 3, xhtml, mtl, network, filepath, process, directory,
template-haskell, bytestring, zip-archive, utf8-string, old-time
Hs-Source-Dirs: .
Exposed-Modules: Text.Pandoc,
Text.Pandoc.Blocks,